void libblis_test_xpbym_check
(
test_params_t* params,
obj_t* x,
obj_t* beta,
obj_t* y,
obj_t* y_orig,
double* resid
)
{
num_t dt = bli_obj_dt( y );
num_t dt_real = bli_obj_dt_proj_to_real( y );
dim_t m = bli_obj_length( y );
dim_t n = bli_obj_width( y );
obj_t x_temp, y_temp;
obj_t norm;
double junk;
//
// Pre-conditions:
// - x is randomized.
// - y_orig is randomized.
// Note:
// - alpha should have a non-zero imaginary component in the complex
// cases in order to more fully exercise the implementation.
//
// Under these conditions, we assume that the implementation for
//
// y := beta * y_orig + conjx(x)
//
// is functioning correctly if
//
// normf( y - ( beta * y_orig + conjx(x) ) )
//
// is negligible.
//
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_create( dt, m, n, 0, 0, &x_temp );
bli_obj_create( dt, m, n, 0, 0, &y_temp );
bli_copym( x, &x_temp );
bli_copym( y_orig, &y_temp );
bli_scalm( beta, &y_temp );
bli_addm( &x_temp, &y_temp );
bli_subm( &y_temp, y );
bli_normfm( y, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &x_temp );
bli_obj_free( &y_temp );
}
void libblis_test_scalm_check( obj_t* beta,
obj_t* y,
obj_t* y_orig,
double* resid )
{
num_t dt = bli_obj_datatype( *y );
num_t dt_real = bli_obj_datatype_proj_to_real( *y );
dim_t m = bli_obj_length( *y );
dim_t n = bli_obj_width( *y );
obj_t norm_y_r;
obj_t nbeta;
obj_t y2;
double junk;
//
// Pre-conditions:
// - y_orig is randomized.
// Note:
// - beta should have a non-zero imaginary component in the complex
// cases in order to more fully exercise the implementation.
//
// Under these conditions, we assume that the implementation for
//
// y := conjbeta(beta) * y_orig
//
// is functioning correctly if
//
// normf( y + -conjbeta(beta) * y_orig )
//
// is negligible.
//
bli_obj_create( dt, m, n, 0, 0, &y2 );
bli_copym( y_orig, &y2 );
bli_obj_scalar_init_detached( dt, &nbeta );
bli_obj_scalar_init_detached( dt_real, &norm_y_r );
bli_copysc( beta, &nbeta );
bli_mulsc( &BLIS_MINUS_ONE, &nbeta );
bli_scalm( &nbeta, &y2 );
bli_addm( &y2, y );
bli_normfm( y, &norm_y_r );
bli_getsc( &norm_y_r, resid, &junk );
bli_obj_free( &y2 );
}
void libblis_test_normfm_impl( iface_t iface,
obj_t* x,
obj_t* norm )
{
switch ( iface )
{
case BLIS_TEST_SEQ_FRONT_END:
bli_normfm( x, norm );
break;
default:
libblis_test_printf_error( "Invalid interface type.\n" );
}
}
void libblis_test_copym_check
(
test_params_t* params,
obj_t* x,
obj_t* y,
double* resid
)
{
num_t dt_real = bli_obj_dt_proj_to_real( x );
obj_t norm_y_r;
double junk;
//
// Pre-conditions:
// - x is randomized.
//
// Under these conditions, we assume that the implementation for
//
// y := conjx(x)
//
// is functioning correctly if
//
// normfm( y - conjx(x) )
//
// is negligible.
//
bli_obj_scalar_init_detached( dt_real, &norm_y_r );
bli_subm( x, y );
bli_normfm( y, &norm_y_r );
bli_getsc( &norm_y_r, resid, &junk );
}
void libblis_test_subm_check
(
test_params_t* params,
obj_t* alpha,
obj_t* beta,
obj_t* x,
obj_t* y,
double* resid
)
{
num_t dt = bli_obj_datatype( *y );
num_t dt_real = bli_obj_datatype_proj_to_real( *y );
dim_t m = bli_obj_length( *y );
dim_t n = bli_obj_width( *y );
conj_t conjx = bli_obj_conj_status( *x );
obj_t aminusb;
obj_t alpha_conj;
obj_t norm_r, m_r, n_r, temp_r;
double junk;
//
// Pre-conditions:
// - x is set to alpha.
// - y_orig is set to beta.
// Note:
// - alpha and beta should have non-zero imaginary components in the
// complex cases in order to more fully exercise the implementation.
//
// Under these conditions, we assume that the implementation for
//
// y := y_orig - conjx(x)
//
// is functioning correctly if
//
// normfv(y) - sqrt( absqsc( beta - conjx(alpha) ) * m * n )
//
// is negligible.
//
bli_obj_scalar_init_detached( dt, &aminusb );
bli_obj_scalar_init_detached( dt_real, &temp_r );
bli_obj_scalar_init_detached( dt_real, &norm_r );
bli_obj_scalar_init_detached( dt_real, &m_r );
bli_obj_scalar_init_detached( dt_real, &n_r );
bli_obj_scalar_init_detached_copy_of( dt, conjx, alpha, &alpha_conj );
bli_normfm( y, &norm_r );
bli_copysc( beta, &aminusb );
bli_subsc( &alpha_conj, &aminusb );
bli_setsc( ( double )m, 0.0, &m_r );
bli_setsc( ( double )n, 0.0, &n_r );
bli_absqsc( &aminusb, &temp_r );
bli_mulsc( &m_r, &temp_r );
bli_mulsc( &n_r, &temp_r );
bli_sqrtsc( &temp_r, &temp_r );
bli_subsc( &temp_r, &norm_r );
bli_getsc( &norm_r, resid, &junk );
}
