void bli_obj_create_const_copy_of( obj_t* a, obj_t* b )
{
gint_t* temp_i;
float* temp_s;
double* temp_d;
scomplex* temp_c;
dcomplex* temp_z;
void* buf_a;
dcomplex value;
if ( bli_error_checking_is_enabled() )
bli_obj_create_const_copy_of_check( a, b );
bli_obj_create( BLIS_CONSTANT, 1, 1, 1, 1, b );
temp_s = bli_obj_buffer_for_const( BLIS_FLOAT, *b );
temp_d = bli_obj_buffer_for_const( BLIS_DOUBLE, *b );
temp_c = bli_obj_buffer_for_const( BLIS_SCOMPLEX, *b );
temp_z = bli_obj_buffer_for_const( BLIS_DCOMPLEX, *b );
temp_i = bli_obj_buffer_for_const( BLIS_INT, *b );
buf_a = bli_obj_buffer_at_off( *a );
bli_zzsets( 0.0, 0.0, value );
if ( bli_obj_is_float( *a ) )
{
bli_szcopys( *(( float* )buf_a), value );
}
else if ( bli_obj_is_double( *a ) )
{
bli_dzcopys( *(( double* )buf_a), value );
}
else if ( bli_obj_is_scomplex( *a ) )
{
bli_czcopys( *(( scomplex* )buf_a), value );
}
else if ( bli_obj_is_dcomplex( *a ) )
{
bli_zzcopys( *(( dcomplex* )buf_a), value );
}
else
{
bli_check_error_code( BLIS_NOT_YET_IMPLEMENTED );
}
bli_zscopys( value, *temp_s );
bli_zdcopys( value, *temp_d );
bli_zccopys( value, *temp_c );
bli_zzcopys( value, *temp_z );
*temp_i = ( gint_t ) bli_zreal( value );
}
void libblis_test_setv_check( obj_t* beta,
obj_t* x,
double* resid )
{
num_t dt_x = bli_obj_datatype( *x );
dim_t m_x = bli_obj_vector_dim( *x );
inc_t inc_x = bli_obj_vector_inc( *x );
void* buf_x = bli_obj_buffer_at_off( *x );
void* buf_beta = bli_obj_buffer_for_1x1( dt_x, *beta );
dim_t i;
*resid = 0.0;
//
// The easiest way to check that setv was successful is to confirm
// that each element of x is equal to beta.
//
if ( bli_obj_is_float( *x ) )
{
float* chi1 = buf_x;
float* beta_cast = buf_beta;
for ( i = 0; i < m_x; ++i )
{
if ( !bli_seq( *chi1, *beta_cast ) ) { *resid = 1.0; return; }
chi1 += inc_x;
}
}
else if ( bli_obj_is_double( *x ) )
{
double* chi1 = buf_x;
double* beta_cast = buf_beta;
for ( i = 0; i < m_x; ++i )
{
if ( !bli_deq( *chi1, *beta_cast ) ) { *resid = 1.0; return; }
chi1 += inc_x;
}
}
else if ( bli_obj_is_scomplex( *x ) )
{
scomplex* chi1 = buf_x;
scomplex* beta_cast = buf_beta;
for ( i = 0; i < m_x; ++i )
{
if ( !bli_ceq( *chi1, *beta_cast ) ) { *resid = 1.0; return; }
chi1 += inc_x;
}
}
else // if ( bli_obj_is_dcomplex( *x ) )
{
dcomplex* chi1 = buf_x;
dcomplex* beta_cast = buf_beta;
for ( i = 0; i < m_x; ++i )
{
if ( !bli_zeq( *chi1, *beta_cast ) ) { *resid = 1.0; return; }
chi1 += inc_x;
}
}
}
void libblis_test_randm_check( obj_t* x,
double* resid )
{
doff_t diagoffx = bli_obj_diag_offset( *x );
uplo_t uplox = bli_obj_uplo( *x );
dim_t m_x = bli_obj_length( *x );
dim_t n_x = bli_obj_width( *x );
inc_t rs_x = bli_obj_row_stride( *x );
inc_t cs_x = bli_obj_col_stride( *x );
void* buf_x = bli_obj_buffer_at_off( *x );
*resid = 0.0;
//
// The two most likely ways that randm would fail is if all elements
// were zero, or if all elements were greater than or equal to one.
// We check both of these conditions by computing the sum of the
// absolute values of the elements of x.
//
if ( bli_obj_is_float( *x ) )
{
float sum_x;
bli_sabsumm( diagoffx,
uplox,
m_x,
n_x,
buf_x, rs_x, cs_x,
&sum_x );
if ( sum_x == *bli_s0 ) *resid = 1.0;
else if ( sum_x >= 1.0 * m_x * n_x ) *resid = 2.0;
}
else if ( bli_obj_is_double( *x ) )
{
double sum_x;
bli_dabsumm( diagoffx,
uplox,
m_x,
n_x,
buf_x, rs_x, cs_x,
&sum_x );
if ( sum_x == *bli_d0 ) *resid = 1.0;
else if ( sum_x >= 1.0 * m_x * n_x ) *resid = 2.0;
}
else if ( bli_obj_is_scomplex( *x ) )
{
float sum_x;
bli_cabsumm( diagoffx,
uplox,
m_x,
n_x,
buf_x, rs_x, cs_x,
&sum_x );
if ( sum_x == *bli_s0 ) *resid = 1.0;
else if ( sum_x >= 2.0 * m_x * n_x ) *resid = 2.0;
}
else // if ( bli_obj_is_dcomplex( *x ) )
{
double sum_x;
bli_zabsumm( diagoffx,
uplox,
m_x,
n_x,
buf_x, rs_x, cs_x,
&sum_x );
if ( sum_x == *bli_d0 ) *resid = 1.0;
else if ( sum_x >= 2.0 * m_x * n_x ) *resid = 2.0;
}
}
void libblis_test_randv_check( obj_t* x,
double* resid )
{
dim_t m_x = bli_obj_vector_dim( *x );
inc_t inc_x = bli_obj_vector_inc( *x );
void* buf_x = bli_obj_buffer_at_off( *x );
*resid = 0.0;
//
// The two most likely ways that randv would fail is if all elements
// were zero, or if all elements were greater than or equal to one.
// We check both of these conditions by computing the sum of the
// absolute values of the elements of x.
//
if ( bli_obj_is_float( *x ) )
{
float sum_x;
bli_sabsumv( m_x,
buf_x, inc_x,
&sum_x );
if ( sum_x == *bli_s0 ) *resid = 1.0;
else if ( sum_x >= 1.0 * m_x ) *resid = 2.0;
}
else if ( bli_obj_is_double( *x ) )
{
double sum_x;
bli_dabsumv( m_x,
buf_x, inc_x,
&sum_x );
if ( sum_x == *bli_d0 ) *resid = 1.0;
else if ( sum_x >= 1.0 * m_x ) *resid = 2.0;
}
else if ( bli_obj_is_scomplex( *x ) )
{
float sum_x;
bli_cabsumv( m_x,
buf_x, inc_x,
&sum_x );
if ( sum_x == *bli_s0 ) *resid = 1.0;
else if ( sum_x >= 2.0 * m_x ) *resid = 2.0;
}
else // if ( bli_obj_is_dcomplex( *x ) )
{
double sum_x;
bli_zabsumv( m_x,
buf_x, inc_x,
&sum_x );
if ( sum_x == *bli_d0 ) *resid = 1.0;
else if ( sum_x >= 2.0 * m_x ) *resid = 2.0;
}
}
void libblis_test_setm_check
(
test_params_t* params,
obj_t* beta,
obj_t* x,
double* resid
)
{
num_t dt_x = bli_obj_datatype( *x );
dim_t m_x = bli_obj_length( *x );
dim_t n_x = bli_obj_width( *x );
inc_t rs_x = bli_obj_row_stride( *x );
inc_t cs_x = bli_obj_col_stride( *x );
void* buf_x = bli_obj_buffer_at_off( *x );
void* buf_beta = bli_obj_buffer_for_1x1( dt_x, *beta );
dim_t i, j;
*resid = 0.0;
//
// The easiest way to check that setm was successful is to confirm
// that each element of x is equal to beta.
//
if ( bli_obj_is_float( *x ) )
{
float* beta_cast = buf_beta;
float* buf_x_cast = buf_x;
float* chi1;
for ( j = 0; j < n_x; ++j )
{
for ( i = 0; i < m_x; ++i )
{
chi1 = buf_x_cast + (i )*rs_x + (j )*cs_x;
if ( !bli_seq( *chi1, *beta_cast ) ) { *resid = 1.0; return; }
}
}
}
else if ( bli_obj_is_double( *x ) )
{
double* beta_cast = buf_beta;
double* buf_x_cast = buf_x;
double* chi1;
for ( j = 0; j < n_x; ++j )
{
for ( i = 0; i < m_x; ++i )
{
chi1 = buf_x_cast + (i )*rs_x + (j )*cs_x;
if ( !bli_deq( *chi1, *beta_cast ) ) { *resid = 1.0; return; }
}
}
}
else if ( bli_obj_is_scomplex( *x ) )
{
scomplex* beta_cast = buf_beta;
scomplex* buf_x_cast = buf_x;
scomplex* chi1;
for ( j = 0; j < n_x; ++j )
{
for ( i = 0; i < m_x; ++i )
{
chi1 = buf_x_cast + (i )*rs_x + (j )*cs_x;
if ( !bli_ceq( *chi1, *beta_cast ) ) { *resid = 1.0; return; }
}
}
}
else // if ( bli_obj_is_dcomplex( *x ) )
{
dcomplex* beta_cast = buf_beta;
dcomplex* buf_x_cast = buf_x;
dcomplex* chi1;
for ( j = 0; j < n_x; ++j )
{
for ( i = 0; i < m_x; ++i )
{
chi1 = buf_x_cast + (i )*rs_x + (j )*cs_x;
if ( !bli_zeq( *chi1, *beta_cast ) ) { *resid = 1.0; return; }
}
}
}
}