FLA_Error FLA_Copy( FLA_Obj A, FLA_Obj B )
{
FLA_Error r_val;
#ifdef FLA_ENABLE_BLAS1_FRONT_END_CNTL_TREES
// Check parameters.
if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
FLA_Copy_check( A, B );
// Invoke FLA_Copy_internal() with flat control tree that simply calls
// external wrapper.
r_val = FLA_Copy_internal( A, B, fla_copy_cntl_blas );
#else
r_val = FLA_Copy_external( A, B );
#endif
return r_val;
}
FLA_Error FLASH_Copy( FLA_Obj A, FLA_Obj B )
{
FLA_Error r_val;
// Check parameters.
if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
FLA_Copy_check( A, B );
// Begin a parallel region.
FLASH_Queue_begin();
// Execute tasks.
r_val = FLA_Copy_internal( A, B, flash_copy_cntl );
// End the parallel region.
FLASH_Queue_end();
return r_val;
}
FLA_Error FLA_Copy_external( FLA_Obj A, FLA_Obj B )
{
FLA_Datatype dt_A;
FLA_Datatype dt_B;
int m_B, n_B;
int rs_A, cs_A;
int rs_B, cs_B;
trans_t blis_trans;
if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
FLA_Copy_check( A, B );
if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
dt_A = FLA_Obj_datatype( A );
dt_B = FLA_Obj_datatype( B );
rs_A = FLA_Obj_row_stride( A );
cs_A = FLA_Obj_col_stride( A );
m_B = FLA_Obj_length( B );
n_B = FLA_Obj_width( B );
rs_B = FLA_Obj_row_stride( B );
cs_B = FLA_Obj_col_stride( B );
if ( FLA_Obj_is_conformal_to( FLA_NO_TRANSPOSE, A, B ) )
FLA_Param_map_flame_to_blis_trans( FLA_NO_TRANSPOSE, &blis_trans );
else // if ( FLA_Obj_is_conformal_to( FLA_TRANSPOSE, A, B ) )
FLA_Param_map_flame_to_blis_trans( FLA_TRANSPOSE, &blis_trans );
// If A is of type FLA_CONSTANT, then we have to proceed based on the
// datatype of B.
if ( dt_A == FLA_CONSTANT )
{
if ( dt_B == FLA_FLOAT )
{
float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
float *buff_B = ( float * ) FLA_FLOAT_PTR( B );
bli_scopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_DOUBLE )
{
double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
double *buff_B = ( double * ) FLA_DOUBLE_PTR( B );
bli_dcopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_COMPLEX )
{
scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
bli_ccopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_DOUBLE_COMPLEX )
{
dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
bli_zcopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
}
else if ( dt_A == FLA_INT )
{
int* buff_A = ( int * ) FLA_INT_PTR( A );
int* buff_B = ( int * ) FLA_INT_PTR( B );
bli_icopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_A == FLA_FLOAT )
{
float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
if ( dt_B == FLA_FLOAT )
{
float *buff_B = ( float * ) FLA_FLOAT_PTR( B );
bli_scopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_DOUBLE )
{
double *buff_B = ( double * ) FLA_DOUBLE_PTR( B );
bli_sdcopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_COMPLEX )
{
scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
bli_sccopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_DOUBLE_COMPLEX )
{
dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
bli_szcopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
}
else if ( dt_A == FLA_DOUBLE )
{
double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
if ( dt_B == FLA_FLOAT )
{
float *buff_B = ( float * ) FLA_FLOAT_PTR( B );
bli_dscopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_DOUBLE )
{
double *buff_B = ( double * ) FLA_DOUBLE_PTR( B );
bli_dcopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_COMPLEX )
{
scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
bli_dccopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_DOUBLE_COMPLEX )
{
dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
bli_dzcopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
}
else if ( dt_A == FLA_COMPLEX )
{
scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
if ( dt_B == FLA_FLOAT )
{
float *buff_B = ( float * ) FLA_FLOAT_PTR( B );
bli_cscopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_DOUBLE )
{
double *buff_B = ( double * ) FLA_DOUBLE_PTR( B );
bli_cdcopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_COMPLEX )
{
scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
bli_ccopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_DOUBLE_COMPLEX )
{
dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
bli_czcopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
}
else if ( dt_A == FLA_DOUBLE_COMPLEX )
{
dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
if ( dt_B == FLA_FLOAT )
{
float *buff_B = ( float * ) FLA_FLOAT_PTR( B );
bli_zscopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_DOUBLE )
{
double *buff_B = ( double * ) FLA_DOUBLE_PTR( B );
bli_zdcopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_COMPLEX )
{
scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
bli_zccopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
else if ( dt_B == FLA_DOUBLE_COMPLEX )
{
dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
bli_zcopymt( blis_trans,
m_B,
n_B,
buff_A, rs_A, cs_A,
buff_B, rs_B, cs_B );
}
}
return FLA_SUCCESS;
}