void libblis_test_amaxv_check
(
test_params_t* params,
obj_t* x,
obj_t* index,
double* resid
)
{
obj_t index_test;
obj_t chi_i;
obj_t chi_i_test;
dim_t i;
dim_t i_test;
double i_d, junk;
double i_d_test;
//
// Pre-conditions:
// - x is randomized.
//
// Under these conditions, we assume that the implementation for
//
// index := amaxv( x )
//
// is functioning correctly if
//
// x[ index ] = max( x )
//
// where max() is implemented via the bli_?amaxv_test() function.
//
// The following two calls have already been made by the caller. That
// is, the index object has already been created and the library's
// amaxv implementation has already been tested.
//bli_obj_scalar_init_detached( BLIS_INT, &index );
//bli_amaxv( x, &index );
bli_getsc( index, &i_d, &junk );
i = i_d;
bli_acquire_vi( i, x, &chi_i );
bli_obj_scalar_init_detached( BLIS_INT, &index_test );
bli_amaxv_test( x, &index_test );
bli_getsc( &index_test, &i_d_test, &junk );
i_test = i_d_test;
bli_acquire_vi( i_test, x, &chi_i_test );
// Verify that the values referenced by index and index_test are equal.
if ( bli_obj_equals( &chi_i, &chi_i_test ) ) *resid = 0.0;
else *resid = 1.0;
}
void libblis_test_addv_check( obj_t* alpha,
obj_t* beta,
obj_t* x,
obj_t* y,
double* resid )
{
num_t dt = bli_obj_datatype( *x );
num_t dt_real = bli_obj_datatype_proj_to_real( *x );
dim_t m = bli_obj_vector_dim( *x );
conj_t conjx = bli_obj_conj_status( *x );
obj_t aplusb;
obj_t alpha_conj;
obj_t norm_r, m_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
//
// fnormv(y) - sqrt( absqsc( beta + conjx(alpha) ) * m )
//
// is negligible.
//
bli_obj_scalar_init_detached( dt, &aplusb );
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_copy_of( dt, conjx, alpha, &alpha_conj );
bli_fnormv( y, &norm_r );
bli_copysc( beta, &aplusb );
bli_addsc( &alpha_conj, &aplusb );
bli_setsc( ( double )m, 0.0, &m_r );
bli_absqsc( &aplusb, &temp_r );
bli_mulsc( &m_r, &temp_r );
bli_sqrtsc( &temp_r, &temp_r );
bli_subsc( &temp_r, &norm_r );
bli_getsc( &norm_r, resid, &junk );
}
void libblis_test_hemv_check( obj_t* alpha,
obj_t* a,
obj_t* x,
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_vector_dim( *y );
obj_t v;
obj_t norm;
double junk;
//
// Pre-conditions:
// - a is randomized and Hermitian.
// - x is randomized.
// - y_orig is randomized.
// 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 := beta * y_orig + alpha * conja(A) * conjx(x)
//
// is functioning correctly if
//
// normf( y - v )
//
// is negligible, where
//
// v = beta * y_orig + alpha * conja(A_dense) * x
//
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_create( dt, m, 1, 0, 0, &v );
bli_copyv( y_orig, &v );
bli_mkherm( a );
bli_obj_set_struc( BLIS_GENERAL, *a );
bli_obj_set_uplo( BLIS_DENSE, *a );
bli_gemv( alpha, a, x, beta, &v );
bli_subv( &v, y );
bli_normfv( y, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &v );
}
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_scalv_check
(
test_params_t* params,
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_vector_dim( 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, 1, 0, 0, &y2 );
bli_copyv( 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_scalv( &nbeta, &y2 );
bli_addv( &y2, y );
bli_normfv( y, &norm_y_r );
bli_getsc( &norm_y_r, resid, &junk );
bli_obj_free( &y2 );
}
void libblis_test_axpbyv_check( obj_t* alpha,
obj_t* x,
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_vector_dim( *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 + alpha * conjx(x)
//
// is functioning correctly if
//
// normf( y - ( beta * y_orig + alpha * conjx(x) ) )
//
// is negligible.
//
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_create( dt, m, 1, 0, 0, &x_temp );
bli_obj_create( dt, m, 1, 0, 0, &y_temp );
bli_copyv( x, &x_temp );
bli_copyv( y_orig, &y_temp );
bli_scalv( alpha, &x_temp );
bli_scalv( beta, &y_temp );
bli_addv( &x_temp, &y_temp );
bli_subv( &y_temp, y );
bli_normfv( y, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &x_temp );
bli_obj_free( &y_temp );
}
err_t bli_check_real_valued_object( obj_t* a )
{
err_t e_val = BLIS_SUCCESS;
double a_real;
double a_imag;
bli_getsc( a, &a_real, &a_imag );
if ( a_imag != 0.0 )
e_val = BLIS_EXPECTED_REAL_VALUED_OBJECT;
return e_val;
}
void libblis_test_normfm_check
(
test_params_t* params,
obj_t* beta,
obj_t* x,
obj_t* norm,
double* resid
)
{
num_t dt_real = bli_obj_datatype_proj_to_real( *x );
dim_t m = bli_obj_length( *x );
dim_t n = bli_obj_width( *x );
obj_t m_r, n_r, temp_r;
double junk;
//
// Pre-conditions:
// - x is set to beta.
// 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
//
// norm := normf( x )
//
// is functioning correctly if
//
// norm = sqrt( absqsc( beta ) * m * n )
//
// where m and n are the dimensions of x.
//
bli_obj_scalar_init_detached( dt_real, &temp_r );
bli_obj_scalar_init_detached( dt_real, &m_r );
bli_obj_scalar_init_detached( dt_real, &n_r );
bli_setsc( ( double )m, 0.0, &m_r );
bli_setsc( ( double )n, 0.0, &n_r );
bli_absqsc( beta, &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 );
bli_getsc( norm, resid, &junk );
}
void libblis_test_fnormv_check( obj_t* beta,
obj_t* x,
obj_t* norm,
double* resid )
{
num_t dt_real = bli_obj_datatype_proj_to_real( *x );
dim_t m = bli_obj_vector_dim( *x );
obj_t m_r, temp_r;
double junk;
//
// Pre-conditions:
// - x is set to beta.
// 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
//
// norm := fnorm( x )
//
// is functioning correctly if
//
// norm = sqrt( absqsc( beta ) * m )
//
// where m is the length of x.
//
bli_obj_init_scalar( dt_real, &temp_r );
bli_obj_init_scalar( dt_real, &m_r );
bli_setsc( ( double )m, 0.0, &m_r );
bli_absqsc( beta, &temp_r );
bli_mulsc( &m_r, &temp_r );
bli_sqrtsc( &temp_r, &temp_r );
bli_subsc( &temp_r, norm );
bli_getsc( norm, resid, &junk );
}
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_syr2_check( obj_t* alpha,
obj_t* x,
obj_t* y,
obj_t* a,
obj_t* a_orig,
double* resid )
{
num_t dt = bli_obj_datatype( *a );
num_t dt_real = bli_obj_datatype_proj_to_real( *a );
dim_t m_a = bli_obj_length( *a );
obj_t xt, yt;
obj_t t, v, w1, w2;
obj_t tau, rho, norm;
double junk;
//
// Pre-conditions:
// - x is randomized.
// - y is randomized.
// - a is randomized and symmetric.
// 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
//
// A := A_orig + alpha * conjx(x) * conjy(y)^T + alpha * conjy(y) * conjx(x)^T
//
// is functioning correctly if
//
// normf( v - w )
//
// is negligible, where
//
// v = A * t
// w = ( A_orig + alpha * conjx(x) * conjy(y)^T + alpha * conjy(y) * conjx(x)^T ) * t
// = A_orig * t + alpha * conjx(x) * conjy(y)^T * t + alpha * conjy(y) * conjx(x)^T * t
// = A_orig * t + alpha * conjx(x) * conjy(y)^T * t + alpha * conjy(y) * rho
// = A_orig * t + alpha * conjx(x) * conjy(y)^T * t + w1
// = A_orig * t + alpha * conjx(x) * rho + w1
// = A_orig * t + w2 + w1
//
bli_mksymm( a );
bli_mksymm( a_orig );
bli_obj_set_struc( BLIS_GENERAL, *a );
bli_obj_set_struc( BLIS_GENERAL, *a_orig );
bli_obj_set_uplo( BLIS_DENSE, *a );
bli_obj_set_uplo( BLIS_DENSE, *a_orig );
bli_obj_scalar_init_detached( dt, &tau );
bli_obj_scalar_init_detached( dt, &rho );
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_create( dt, m_a, 1, 0, 0, &t );
bli_obj_create( dt, m_a, 1, 0, 0, &v );
bli_obj_create( dt, m_a, 1, 0, 0, &w1 );
bli_obj_create( dt, m_a, 1, 0, 0, &w2 );
bli_obj_alias_to( *x, xt );
bli_obj_alias_to( *y, yt );
bli_setsc( 1.0/( double )m_a, -1.0/( double )m_a, &tau );
bli_setv( &tau, &t );
bli_gemv( &BLIS_ONE, a, &t, &BLIS_ZERO, &v );
bli_dotv( &xt, &t, &rho );
bli_mulsc( alpha, &rho );
bli_scal2v( &rho, y, &w1 );
bli_dotv( &yt, &t, &rho );
bli_mulsc( alpha, &rho );
bli_scal2v( &rho, x, &w2 );
bli_addv( &w2, &w1 );
bli_gemv( &BLIS_ONE, a_orig, &t, &BLIS_ONE, &w1 );
bli_subv( &w1, &v );
bli_normfv( &v, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &t );
bli_obj_free( &v );
bli_obj_free( &w1 );
bli_obj_free( &w2 );
}
void libblis_test_gemmtrsm_ukr_check( side_t side,
obj_t* alpha,
obj_t* a1x,
obj_t* a11,
obj_t* bx1,
obj_t* b11,
obj_t* c11,
obj_t* c11_orig,
double* resid )
{
num_t dt = bli_obj_datatype( *b11 );
num_t dt_real = bli_obj_datatype_proj_to_real( *b11 );
dim_t m = bli_obj_length( *b11 );
dim_t n = bli_obj_width( *b11 );
dim_t k = bli_obj_width( *a1x );
obj_t kappa, norm;
obj_t t, v, w, z;
double junk;
//
// Pre-conditions:
// - a1x, a11, bx1, c11_orig are randomized; a11 is triangular.
// - contents of b11 == contents of c11.
// - side == BLIS_LEFT.
//
// Under these conditions, we assume that the implementation for
//
// B := inv(A11) * ( alpha * B11 - A1x * Bx1 ) (side = left)
//
// is functioning correctly if
//
// fnorm( v - z )
//
// is negligible, where
//
// v = B11 * t
//
// z = ( inv(A11) * ( alpha * B11_orig - A1x * Bx1 ) ) * t
// = inv(A11) * ( alpha * B11_orig * t - A1x * Bx1 * t )
// = inv(A11) * ( alpha * B11_orig * t - A1x * w )
//
bli_obj_scalar_init_detached( dt, &kappa );
bli_obj_scalar_init_detached( dt_real, &norm );
if ( bli_is_left( side ) )
{
bli_obj_create( dt, n, 1, 0, 0, &t );
bli_obj_create( dt, m, 1, 0, 0, &v );
bli_obj_create( dt, k, 1, 0, 0, &w );
bli_obj_create( dt, m, 1, 0, 0, &z );
}
else // else if ( bli_is_left( side ) )
{
// BLIS does not currently support right-side micro-kernels.
bli_check_error_code( BLIS_NOT_YET_IMPLEMENTED );
}
bli_randv( &t );
bli_setsc( 1.0/( double )n, 0.0, &kappa );
bli_scalv( &kappa, &t );
bli_gemv( &BLIS_ONE, b11, &t, &BLIS_ZERO, &v );
// Restore the diagonal of a11 to its original, un-inverted state
// (needed for trsv).
bli_invertd( a11 );
if ( bli_is_left( side ) )
{
bli_gemv( &BLIS_ONE, bx1, &t, &BLIS_ZERO, &w );
bli_gemv( alpha, c11_orig, &t, &BLIS_ZERO, &z );
bli_gemv( &BLIS_MINUS_ONE, a1x, &w, &BLIS_ONE, &z );
bli_trsv( &BLIS_ONE, a11, &z );
}
else // else if ( bli_is_left( side ) )
{
// BLIS does not currently support right-side micro-kernels.
bli_check_error_code( BLIS_NOT_YET_IMPLEMENTED );
}
bli_subv( &z, &v );
bli_fnormv( &v, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &t );
bli_obj_free( &v );
bli_obj_free( &w );
bli_obj_free( &z );
}
void libblis_test_dotaxpyv_check( obj_t* alpha,
obj_t* xt,
obj_t* x,
obj_t* y,
obj_t* rho,
obj_t* z,
obj_t* z_orig,
double* resid )
{
num_t dt = bli_obj_datatype( *z );
num_t dt_real = bli_obj_datatype_proj_to_real( *z );
dim_t m = bli_obj_vector_dim( *z );
obj_t rho_temp;
obj_t z_temp;
obj_t norm_z;
double resid1, resid2;
double junk;
//
// Pre-conditions:
// - x is randomized.
// - y is randomized.
// - z_orig is randomized.
// - xt is an alias to x.
// 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
//
// rho := conjxt(x^T) conjy(y)
// z := z_orig + alpha * conjx(x)
//
// is functioning correctly if
//
// ( rho - rho_temp )
//
// and
//
// normf( z - z_temp )
//
// are negligible, where rho_temp and z_temp contain rho and z as
// computed by dotv and axpyv, respectively.
//
bli_obj_scalar_init_detached( dt, &rho_temp );
bli_obj_scalar_init_detached( dt_real, &norm_z );
bli_obj_create( dt, m, 1, 0, 0, &z_temp );
bli_copyv( z_orig, &z_temp );
bli_dotv( xt, y, &rho_temp );
bli_axpyv( alpha, x, &z_temp );
bli_subsc( rho, &rho_temp );
bli_getsc( &rho_temp, &resid1, &junk );
bli_subv( &z_temp, z );
bli_normfv( z, &norm_z );
bli_getsc( &norm_z, &resid2, &junk );
*resid = bli_fmaxabs( resid1, resid2 );
bli_obj_free( &z_temp );
}
void libblis_test_herk_check( obj_t* alpha,
obj_t* a,
obj_t* beta,
obj_t* c,
obj_t* c_orig,
double* resid )
{
num_t dt = bli_obj_datatype( *c );
num_t dt_real = bli_obj_datatype_proj_to_real( *c );
dim_t m = bli_obj_length( *c );
dim_t k = bli_obj_width_after_trans( *a );
obj_t ah;
obj_t kappa, norm;
obj_t t, v, w, z;
double junk;
//
// Pre-conditions:
// - a is randomized.
// - c_orig is randomized and Hermitian.
// Note:
// - alpha and beta must be real-valued.
//
// Under these conditions, we assume that the implementation for
//
// C := beta * C_orig + alpha * transa(A) * transa(A)^H
//
// is functioning correctly if
//
// fnorm( v - z )
//
// is negligible, where
//
// v = C * t
// z = ( beta * C_orig + alpha * transa(A) * transa(A)^H ) * t
// = beta * C_orig * t + alpha * transa(A) * transa(A)^H * t
// = beta * C_orig * t + alpha * transa(A) * w
// = beta * C_orig * t + z
//
bli_obj_alias_with_trans( BLIS_CONJ_TRANSPOSE, *a, ah );
bli_obj_scalar_init_detached( dt, &kappa );
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_create( dt, m, 1, 0, 0, &t );
bli_obj_create( dt, m, 1, 0, 0, &v );
bli_obj_create( dt, k, 1, 0, 0, &w );
bli_obj_create( dt, m, 1, 0, 0, &z );
bli_randv( &t );
bli_setsc( 1.0/( double )m, 0.0, &kappa );
bli_scalv( &kappa, &t );
bli_hemv( &BLIS_ONE, c, &t, &BLIS_ZERO, &v );
bli_gemv( &BLIS_ONE, &ah, &t, &BLIS_ZERO, &w );
bli_gemv( alpha, a, &w, &BLIS_ZERO, &z );
bli_hemv( beta, c_orig, &t, &BLIS_ONE, &z );
bli_subv( &z, &v );
bli_fnormv( &v, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &t );
bli_obj_free( &v );
bli_obj_free( &w );
bli_obj_free( &z );
}
void libblis_test_gemv_check( obj_t* kappa,
obj_t* alpha,
obj_t* a,
obj_t* x,
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 );
conj_t conja = bli_obj_conj_status( *a );
dim_t n_x = bli_obj_vector_dim( *x );
dim_t m_y = bli_obj_vector_dim( *y );
dim_t min_m_n = bli_min( m_y, n_x );
obj_t x_temp, y_temp;
obj_t kappac, norm;
obj_t xT_temp, yT_temp, yT;
double junk;
//
// Pre-conditions:
// - a is initialized to kappa along the diagonal.
// - x is randomized.
// - y_orig is randomized.
// Note:
// - alpha, beta, and kappa 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 := beta * y_orig + alpha * transa(A) * conjx(x)
//
// is functioning correctly if
//
// normf( y - z )
//
// is negligible, where
//
// z = beta * y_orig + alpha * conja(kappa) * x
//
bli_obj_scalar_init_detached_copy_of( dt, conja, kappa, &kappac );
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_create( dt, n_x, 1, 0, 0, &x_temp );
bli_obj_create( dt, m_y, 1, 0, 0, &y_temp );
bli_copyv( x, &x_temp );
bli_copyv( y_orig, &y_temp );
bli_acquire_vpart_f2b( BLIS_SUBPART1, 0, min_m_n,
&x_temp, &xT_temp );
bli_acquire_vpart_f2b( BLIS_SUBPART1, 0, min_m_n,
&y_temp, &yT_temp );
bli_acquire_vpart_f2b( BLIS_SUBPART1, 0, min_m_n,
y, &yT );
bli_scalv( &kappac, &xT_temp );
bli_scalv( beta, &yT_temp );
bli_axpyv( alpha, &xT_temp, &yT_temp );
bli_subv( &yT_temp, &yT );
bli_normfv( &yT, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &x_temp );
bli_obj_free( &y_temp );
}
void libblis_test_her2k_check
(
test_params_t* params,
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
obj_t* c_orig,
double* resid
)
{
num_t dt = bli_obj_datatype( *c );
num_t dt_real = bli_obj_datatype_proj_to_real( *c );
dim_t m = bli_obj_length( *c );
dim_t k = bli_obj_width_after_trans( *a );
obj_t alphac, ah, bh;
obj_t norm;
obj_t t, v, w1, w2, z;
double junk;
//
// Pre-conditions:
// - a is randomized.
// - b is randomized.
// - c_orig is randomized and Hermitian.
// Note:
// - alpha should have a non-zero imaginary component in the
// complex cases in order to more fully exercise the implementation.
// - beta must be real-valued.
//
// Under these conditions, we assume that the implementation for
//
// C := beta * C_orig + alpha * transa(A) * transb(B)^H + conj(alpha) * transb(B) * transa(A)^H
//
// is functioning correctly if
//
// normf( v - z )
//
// is negligible, where
//
// v = C * t
// z = ( beta * C_orig + alpha * transa(A) * transb(B)^H + conj(alpha) * transb(B) * transa(A)^H ) * t
// = beta * C_orig * t + alpha * transa(A) * transb(B)^H * t + conj(alpha) * transb(B) * transa(A)^H * t
// = beta * C_orig * t + alpha * transa(A) * transb(B)^H * t + conj(alpha) * transb(B) * w2
// = beta * C_orig * t + alpha * transa(A) * w1 + conj(alpha) * transb(B) * w2
// = beta * C_orig * t + alpha * transa(A) * w1 + z
// = beta * C_orig * t + z
//
bli_obj_alias_with_trans( BLIS_CONJ_TRANSPOSE, *a, ah );
bli_obj_alias_with_trans( BLIS_CONJ_TRANSPOSE, *b, bh );
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_scalar_init_detached_copy_of( dt, BLIS_CONJUGATE, alpha, &alphac );
bli_obj_create( dt, m, 1, 0, 0, &t );
bli_obj_create( dt, m, 1, 0, 0, &v );
bli_obj_create( dt, k, 1, 0, 0, &w1 );
bli_obj_create( dt, k, 1, 0, 0, &w2 );
bli_obj_create( dt, m, 1, 0, 0, &z );
libblis_test_vobj_randomize( params, TRUE, &t );
bli_hemv( &BLIS_ONE, c, &t, &BLIS_ZERO, &v );
bli_gemv( &BLIS_ONE, &ah, &t, &BLIS_ZERO, &w2 );
bli_gemv( &BLIS_ONE, &bh, &t, &BLIS_ZERO, &w1 );
bli_gemv( alpha, a, &w1, &BLIS_ZERO, &z );
bli_gemv( &alphac, b, &w2, &BLIS_ONE, &z );
bli_hemv( beta, c_orig, &t, &BLIS_ONE, &z );
bli_subv( &z, &v );
bli_normfv( &v, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &t );
bli_obj_free( &v );
bli_obj_free( &w1 );
bli_obj_free( &w2 );
bli_obj_free( &z );
}
void libblis_test_her_check( obj_t* alpha,
obj_t* x,
obj_t* a,
obj_t* a_orig,
double* resid )
{
num_t dt = bli_obj_datatype( *a );
num_t dt_real = bli_obj_datatype_proj_to_real( *a );
dim_t m_a = bli_obj_length( *a );
obj_t xh, t, v, w;
obj_t tau, rho, norm;
double junk;
//
// Pre-conditions:
// - x is randomized.
// - a is randomized and Hermitian.
// Note:
// - alpha must be real-valued.
//
// Under these conditions, we assume that the implementation for
//
// A := A_orig + alpha * conjx(x) * conjx(x)^H
//
// is functioning correctly if
//
// normf( v - w )
//
// is negligible, where
//
// v = A * t
// w = ( A_orig + alpha * conjx(x) * conjx(x)^H ) * t
// = A_orig * t + alpha * conjx(x) * conjx(x)^H * t
// = A_orig * t + alpha * conjx(x) * rho
// = A_orig * t + w
//
bli_mkherm( a );
bli_mkherm( a_orig );
bli_obj_set_struc( BLIS_GENERAL, *a );
bli_obj_set_struc( BLIS_GENERAL, *a_orig );
bli_obj_set_uplo( BLIS_DENSE, *a );
bli_obj_set_uplo( BLIS_DENSE, *a_orig );
bli_obj_scalar_init_detached( dt, &tau );
bli_obj_scalar_init_detached( dt, &rho );
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_create( dt, m_a, 1, 0, 0, &t );
bli_obj_create( dt, m_a, 1, 0, 0, &v );
bli_obj_create( dt, m_a, 1, 0, 0, &w );
bli_obj_alias_with_conj( BLIS_CONJUGATE, *x, xh );
bli_setsc( 1.0/( double )m_a, -1.0/( double )m_a, &tau );
bli_setv( &tau, &t );
bli_gemv( &BLIS_ONE, a, &t, &BLIS_ZERO, &v );
bli_dotv( &xh, &t, &rho );
bli_mulsc( alpha, &rho );
bli_scal2v( &rho, x, &w );
bli_gemv( &BLIS_ONE, a_orig, &t, &BLIS_ONE, &w );
bli_subv( &w, &v );
bli_normfv( &v, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &t );
bli_obj_free( &v );
bli_obj_free( &w );
}
void libblis_test_trsm_check
(
test_params_t* params,
side_t side,
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* b_orig,
double* resid
)
{
num_t dt = bli_obj_datatype( *b );
num_t dt_real = bli_obj_datatype_proj_to_real( *b );
dim_t m = bli_obj_length( *b );
dim_t n = bli_obj_width( *b );
obj_t norm;
obj_t t, v, w, z;
double junk;
//
// Pre-conditions:
// - a is randomized and triangular.
// - b_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
//
// B := alpha * inv(transa(A)) * B_orig (side = left)
// B := alpha * B_orig * inv(transa(A)) (side = right)
//
// is functioning correctly if
//
// normf( v - z )
//
// is negligible, where
//
// v = B * t
//
// z = ( alpha * inv(transa(A)) * B ) * t (side = left)
// = alpha * inv(transa(A)) * B * t
// = alpha * inv(transa(A)) * w
//
// z = ( alpha * B * inv(transa(A)) ) * t (side = right)
// = alpha * B * tinv(ransa(A)) * t
// = alpha * B * w
bli_obj_scalar_init_detached( dt_real, &norm );
if ( bli_is_left( side ) )
{
bli_obj_create( dt, n, 1, 0, 0, &t );
bli_obj_create( dt, m, 1, 0, 0, &v );
bli_obj_create( dt, m, 1, 0, 0, &w );
bli_obj_create( dt, m, 1, 0, 0, &z );
}
else // else if ( bli_is_left( side ) )
{
bli_obj_create( dt, n, 1, 0, 0, &t );
bli_obj_create( dt, m, 1, 0, 0, &v );
bli_obj_create( dt, n, 1, 0, 0, &w );
bli_obj_create( dt, m, 1, 0, 0, &z );
}
libblis_test_vobj_randomize( params, TRUE, &t );
bli_gemv( &BLIS_ONE, b, &t, &BLIS_ZERO, &v );
if ( bli_is_left( side ) )
{
bli_gemv( alpha, b_orig, &t, &BLIS_ZERO, &w );
bli_trsv( &BLIS_ONE, a, &w );
bli_copyv( &w, &z );
}
else
{
bli_copyv( &t, &w );
bli_trsv( &BLIS_ONE, a, &w );
bli_gemv( alpha, b_orig, &w, &BLIS_ZERO, &z );
}
bli_subv( &z, &v );
bli_normfv( &v, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &t );
bli_obj_free( &v );
bli_obj_free( &w );
bli_obj_free( &z );
}
void libblis_test_gemm_md_check
(
test_params_t* params,
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
obj_t* c_orig,
double* resid
)
{
num_t dt_real = bli_obj_dt_proj_to_real( c );
num_t dt_comp = bli_obj_dt_proj_to_complex( c );
num_t dt;
dim_t m = bli_obj_length( c );
dim_t n = bli_obj_width( c );
dim_t k = bli_obj_width_after_trans( a );
obj_t norm;
obj_t t, v, w, z;
double junk;
// Compute our reference checksum in the real domain if all operands
// are real, and in the complex domain otherwise. Also implicit in this
// is that we use the storage precision of C to determine the precision
// in which we perform the reference checksum.
if ( bli_obj_is_real( a ) &&
bli_obj_is_real( b ) &&
bli_obj_is_real( c ) ) dt = dt_real;
else dt = dt_comp;
// This function works in a manner similar to that of the function
// libblis_test_gemm_check(), except that we project a, b, and c into
// the complex domain (regardless of their storage datatype), and then
// proceed with the checking accordingly.
obj_t a2, b2, c2, c0;
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_create( dt, n, 1, 0, 0, &t );
bli_obj_create( dt, m, 1, 0, 0, &v );
bli_obj_create( dt, k, 1, 0, 0, &w );
bli_obj_create( dt, m, 1, 0, 0, &z );
libblis_test_vobj_randomize( params, TRUE, &t );
// We need to zero out the imaginary part of t in order for our
// checks to work in all cases. Otherwise, the imaginary parts
// could affect intermediate products, depending on the order that
// they are executed.
bli_setiv( &BLIS_ZERO, &t );
// Create complex equivalents of a, b, c_orig, and c.
bli_obj_create( dt, m, k, 0, 0, &a2 );
bli_obj_create( dt, k, n, 0, 0, &b2 );
bli_obj_create( dt, m, n, 0, 0, &c2 );
bli_obj_create( dt, m, n, 0, 0, &c0 );
// Cast a, b, c_orig, and c into the datatype of our temporary objects.
bli_castm( a, &a2 );
bli_castm( b, &b2 );
bli_castm( c_orig, &c2 );
bli_castm( c, &c0 );
bli_gemv( &BLIS_ONE, &c0, &t, &BLIS_ZERO, &v );
#if 0
if ( bli_obj_is_scomplex( c ) &&
bli_obj_is_float( a ) &&
bli_obj_is_float( b ) )
{
bli_printm( "test_gemm.c: a", a, "%7.3f", "" );
bli_printm( "test_gemm.c: b", b, "%7.3f", "" );
bli_printm( "test_gemm.c: c orig", c_orig, "%7.3f", "" );
bli_printm( "test_gemm.c: c computed", c, "%7.3f", "" );
}
#endif
#if 0
bli_gemm( alpha, &a2, &b2, beta, &c2 );
bli_gemv( &BLIS_ONE, &c2, &t, &BLIS_ZERO, &z );
if ( bli_obj_is_real( c ) ) bli_setiv( &BLIS_ZERO, &z );
#else
bli_gemv( &BLIS_ONE, &b2, &t, &BLIS_ZERO, &w );
bli_gemv( alpha, &a2, &w, &BLIS_ZERO, &z );
bli_gemv( beta, &c2, &t, &BLIS_ONE, &z );
if ( bli_obj_is_real( c ) ) bli_setiv( &BLIS_ZERO, &z );
#endif
bli_subv( &z, &v );
bli_normfv( &v, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &t );
bli_obj_free( &v );
bli_obj_free( &w );
bli_obj_free( &z );
bli_obj_free( &a2 );
bli_obj_free( &b2 );
bli_obj_free( &c2 );
bli_obj_free( &c0 );
}
void libblis_test_syr2k_check( obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
obj_t* c_orig,
double* resid )
{
num_t dt = bli_obj_datatype( *c );
num_t dt_real = bli_obj_datatype_proj_to_real( *c );
dim_t m = bli_obj_length( *c );
dim_t k = bli_obj_width_after_trans( *a );
obj_t at, bt;
obj_t kappa, norm;
obj_t t, v, w1, w2, z;
double junk;
//
// Pre-conditions:
// - a is randomized.
// - b is randomized.
// - c_orig is randomized and symmetric.
// 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
//
// C := beta * C_orig + alpha * transa(A) * transb(B)^T + alpha * transb(B) * transa(A)^T
//
// is functioning correctly if
//
// normf( v - z )
//
// is negligible, where
//
// v = C * t
// z = ( beta * C_orig + alpha * transa(A) * transb(B)^T + alpha * transb(B) * transa(A)^T ) * t
// = beta * C_orig * t + alpha * transa(A) * transb(B)^T * t + alpha * transb(B) * transa(A)^T * t
// = beta * C_orig * t + alpha * transa(A) * transb(B)^T * t + alpha * transb(B) * w2
// = beta * C_orig * t + alpha * transa(A) * w1 + alpha * transb(B) * w2
// = beta * C_orig * t + alpha * transa(A) * w1 + z
// = beta * C_orig * t + z
//
bli_obj_alias_with_trans( BLIS_TRANSPOSE, *a, at );
bli_obj_alias_with_trans( BLIS_TRANSPOSE, *b, bt );
bli_obj_scalar_init_detached( dt, &kappa );
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_create( dt, m, 1, 0, 0, &t );
bli_obj_create( dt, m, 1, 0, 0, &v );
bli_obj_create( dt, k, 1, 0, 0, &w1 );
bli_obj_create( dt, k, 1, 0, 0, &w2 );
bli_obj_create( dt, m, 1, 0, 0, &z );
bli_randv( &t );
bli_setsc( 1.0/( double )m, 0.0, &kappa );
bli_scalv( &kappa, &t );
bli_symv( &BLIS_ONE, c, &t, &BLIS_ZERO, &v );
bli_gemv( &BLIS_ONE, &at, &t, &BLIS_ZERO, &w2 );
bli_gemv( &BLIS_ONE, &bt, &t, &BLIS_ZERO, &w1 );
bli_gemv( alpha, a, &w1, &BLIS_ZERO, &z );
bli_gemv( alpha, b, &w2, &BLIS_ONE, &z );
bli_symv( beta, c_orig, &t, &BLIS_ONE, &z );
bli_subv( &z, &v );
bli_normfv( &v, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &t );
bli_obj_free( &v );
bli_obj_free( &w1 );
bli_obj_free( &w2 );
bli_obj_free( &z );
}
void libblis_test_ger_check
(
test_params_t* params,
obj_t* alpha,
obj_t* x,
obj_t* y,
obj_t* a,
obj_t* a_orig,
double* resid
)
{
num_t dt = bli_obj_dt( a );
num_t dt_real = bli_obj_dt_proj_to_real( a );
dim_t m_a = bli_obj_length( a );
dim_t n_a = bli_obj_width( a );
obj_t t, v, w;
obj_t rho, norm;
double junk;
//
// Pre-conditions:
// - x is randomized.
// - y is randomized.
// - a is identity.
// 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
//
// A := A_orig + alpha * conjx(x) * conjy(y)
//
// is functioning correctly if
//
// normf( v - w )
//
// is negligible, where
//
// v = A * t
// w = ( A_orig + alpha * conjx(x) * conjy(y)^T ) * t
// = A_orig * t + alpha * conjx(x) * conjy(y)^T * t
// = A_orig * t + alpha * conjx(x) * rho
// = A_orig * t + w
//
bli_obj_scalar_init_detached( dt, &rho );
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_create( dt, n_a, 1, 0, 0, &t );
bli_obj_create( dt, m_a, 1, 0, 0, &v );
bli_obj_create( dt, m_a, 1, 0, 0, &w );
libblis_test_vobj_randomize( params, TRUE, &t );
bli_gemv( &BLIS_ONE, a, &t, &BLIS_ZERO, &v );
bli_dotv( y, &t, &rho );
bli_mulsc( alpha, &rho );
bli_scal2v( &rho, x, &w );
bli_gemv( &BLIS_ONE, a_orig, &t, &BLIS_ONE, &w );
bli_subv( &w, &v );
bli_normfv( &v, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &t );
bli_obj_free( &v );
bli_obj_free( &w );
}
void libblis_test_dotxaxpyf_check
(
test_params_t* params,
obj_t* alpha,
obj_t* at,
obj_t* a,
obj_t* w,
obj_t* x,
obj_t* beta,
obj_t* y,
obj_t* z,
obj_t* y_orig,
obj_t* z_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_vector_dim( *z );
dim_t b_n = bli_obj_vector_dim( *y );
dim_t i;
obj_t a1, chi1, psi1, v, q;
obj_t alpha_chi1;
obj_t norm;
double resid1, resid2;
double junk;
//
// Pre-conditions:
// - a is randomized.
// - w is randomized.
// - x is randomized.
// - y is randomized.
// - z is randomized.
// - at is an alias to a.
// Note:
// - alpha and 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 := beta * y_orig + alpha * conjat(A^T) * conjw(w)
// z := z_orig + alpha * conja(A) * conjx(x)
//
// is functioning correctly if
//
// normf( y - v )
//
// and
//
// normf( z - q )
//
// are negligible, where v and q contain y and z as computed by repeated
// calls to dotxv and axpyv, respectively.
//
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_scalar_init_detached( dt, &alpha_chi1 );
bli_obj_create( dt, b_n, 1, 0, 0, &v );
bli_obj_create( dt, m, 1, 0, 0, &q );
bli_copyv( y_orig, &v );
bli_copyv( z_orig, &q );
// v := beta * v + alpha * conjat(at) * conjw(w)
for ( i = 0; i < b_n; ++i )
{
bli_acquire_mpart_l2r( BLIS_SUBPART1, i, 1, at, &a1 );
bli_acquire_vpart_f2b( BLIS_SUBPART1, i, 1, &v, &psi1 );
bli_dotxv( alpha, &a1, w, beta, &psi1 );
}
// q := q + alpha * conja(a) * conjx(x)
for ( i = 0; i < b_n; ++i )
{
bli_acquire_mpart_l2r( BLIS_SUBPART1, i, 1, a, &a1 );
bli_acquire_vpart_f2b( BLIS_SUBPART1, i, 1, x, &chi1 );
bli_copysc( &chi1, &alpha_chi1 );
bli_mulsc( alpha, &alpha_chi1 );
bli_axpyv( &alpha_chi1, &a1, &q );
}
bli_subv( y, &v );
bli_normfv( &v, &norm );
bli_getsc( &norm, &resid1, &junk );
bli_subv( z, &q );
bli_normfv( &q, &norm );
bli_getsc( &norm, &resid2, &junk );
*resid = bli_fmaxabs( resid1, resid2 );
bli_obj_free( &v );
bli_obj_free( &q );
}
void libblis_test_axpyf_check( obj_t* alpha,
obj_t* a,
obj_t* x,
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_vector_dim( *y );
dim_t b_n = bli_obj_width( *a );
dim_t i;
obj_t a1, chi1, v;
obj_t alpha_chi1;
obj_t norm;
double junk;
//
// Pre-conditions:
// - a is randomized.
// - x is randomized.
// - y 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 := y_orig + alpha * conja(A) * conjx(x)
//
// is functioning correctly if
//
// normf( y - v )
//
// is negligible, where v contains y as computed by repeated calls to
// axpyv.
//
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_scalar_init_detached( dt, &alpha_chi1 );
bli_obj_create( dt, m, 1, 0, 0, &v );
bli_copyv( y_orig, &v );
for ( i = 0; i < b_n; ++i )
{
bli_acquire_mpart_l2r( BLIS_SUBPART1, i, 1, a, &a1 );
bli_acquire_vpart_f2b( BLIS_SUBPART1, i, 1, x, &chi1 );
bli_copysc( &chi1, &alpha_chi1 );
bli_mulsc( alpha, &alpha_chi1 );
bli_axpyv( &alpha_chi1, &a1, &v );
}
bli_subv( y, &v );
bli_normfv( &v, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &v );
}
void libblis_test_gemm_check
(
test_params_t* params,
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
obj_t* c_orig,
double* resid
)
{
num_t dt = bli_obj_dt( c );
num_t dt_real = bli_obj_dt_proj_to_real( c );
dim_t m = bli_obj_length( c );
dim_t n = bli_obj_width( c );
dim_t k = bli_obj_width_after_trans( a );
obj_t norm;
obj_t t, v, w, z;
double junk;
//
// Pre-conditions:
// - a is randomized.
// - b is randomized.
// - c_orig is randomized.
// 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
//
// C := beta * C_orig + alpha * transa(A) * transb(B)
//
// is functioning correctly if
//
// normf( v - z )
//
// is negligible, where
//
// v = C * t
// z = ( beta * C_orig + alpha * transa(A) * transb(B) ) * t
// = beta * C_orig * t + alpha * transa(A) * transb(B) * t
// = beta * C_orig * t + alpha * transa(A) * w
// = beta * C_orig * t + z
//
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_create( dt, n, 1, 0, 0, &t );
bli_obj_create( dt, m, 1, 0, 0, &v );
bli_obj_create( dt, k, 1, 0, 0, &w );
bli_obj_create( dt, m, 1, 0, 0, &z );
libblis_test_vobj_randomize( params, TRUE, &t );
bli_gemv( &BLIS_ONE, c, &t, &BLIS_ZERO, &v );
bli_gemv( &BLIS_ONE, b, &t, &BLIS_ZERO, &w );
bli_gemv( alpha, a, &w, &BLIS_ZERO, &z );
bli_gemv( beta, c_orig, &t, &BLIS_ONE, &z );
bli_subv( &z, &v );
bli_normfv( &v, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &t );
bli_obj_free( &v );
bli_obj_free( &w );
bli_obj_free( &z );
}
void libblis_test_axpy2v_check( obj_t* alpha1,
obj_t* alpha2,
obj_t* x,
obj_t* y,
obj_t* z,
obj_t* z_orig,
double* resid )
{
num_t dt = bli_obj_datatype( *z );
num_t dt_real = bli_obj_datatype_proj_to_real( *z );
dim_t m = bli_obj_vector_dim( *z );
obj_t x_temp, y_temp, z_temp;
obj_t norm;
double junk;
//
// Pre-conditions:
// - x is randomized.
// - y is randomized.
// - z_orig is randomized.
// Note:
// - alpha1, alpha2 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
//
// z := z_orig + alpha1 * conjx(x) + alpha2 * conjy(y)
//
// is functioning correctly if
//
// normf( z - v )
//
// is negligible, where v contains z as computed by two calls to axpyv.
//
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_create( dt, m, 1, 0, 0, &x_temp );
bli_obj_create( dt, m, 1, 0, 0, &y_temp );
bli_obj_create( dt, m, 1, 0, 0, &z_temp );
bli_copyv( x, &x_temp );
bli_copyv( y, &y_temp );
bli_copyv( z_orig, &z_temp );
bli_scalv( alpha1, &x_temp );
bli_scalv( alpha2, &y_temp );
bli_addv( &x_temp, &z_temp );
bli_addv( &y_temp, &z_temp );
bli_subv( &z_temp, z );
bli_normfv( z, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &x_temp );
bli_obj_free( &y_temp );
bli_obj_free( &z_temp );
}
void libblis_test_trmv_check( obj_t* alpha,
obj_t* a,
obj_t* x,
obj_t* x_orig,
double* resid )
{
num_t dt = bli_obj_datatype( *x );
num_t dt_real = bli_obj_datatype_proj_to_real( *x );
dim_t m = bli_obj_vector_dim( *x );
uplo_t uploa = bli_obj_uplo( *a );
trans_t transa = bli_obj_conjtrans_status( *a );
obj_t a_local, y;
obj_t norm;
double junk;
//
// Pre-conditions:
// - a is randomized and triangular.
// - x 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
//
// x := alpha * transa(A) * x_orig
//
// is functioning correctly if
//
// fnorm( y - x )
//
// is negligible, where
//
// y = alpha * conja(A_dense) * x_orig
//
bli_obj_init_scalar( dt_real, &norm );
bli_obj_create( dt, m, 1, 0, 0, &y );
bli_obj_create( dt, m, m, 0, 0, &a_local );
bli_obj_set_struc( BLIS_TRIANGULAR, a_local );
bli_obj_set_uplo( uploa, a_local );
bli_obj_toggle_uplo_if_trans( transa, a_local );
bli_copym( a, &a_local );
bli_mktrim( &a_local );
bli_obj_set_struc( BLIS_GENERAL, a_local );
bli_obj_set_uplo( BLIS_DENSE, a_local );
bli_gemv( alpha, &a_local, x_orig, &BLIS_ZERO, &y );
bli_subv( x, &y );
bli_fnormv( &y, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &y );
bli_obj_free( &a_local );
}
void libblis_test_trmm3_check( side_t side,
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
obj_t* c_orig,
double* resid )
{
num_t dt = bli_obj_datatype( *c );
num_t dt_real = bli_obj_datatype_proj_to_real( *c );
dim_t m = bli_obj_length( *c );
dim_t n = bli_obj_width( *c );
obj_t kappa, norm;
obj_t t, v, w, z;
double junk;
//
// Pre-conditions:
// - a is randomized and triangular.
// - b is randomized.
// - c_orig is randomized.
// 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
//
// C := beta * C_orig + alpha * transa(A) * transb(B) (side = left)
// C := beta * C_orig + alpha * transb(B) * transa(A) (side = right)
//
// is functioning correctly if
//
// fnorm( v - z )
//
// is negligible, where
//
// v = C * t
//
// z = ( beta * C_orig + alpha * transa(A) * transb(B) ) * t (side = left)
// = beta * C_orig * t + alpha * transa(A) * transb(B) * t
// = beta * C_orig * t + alpha * transa(A) * w
// = beta * C_orig * t + z
//
// z = ( beta * C_orig + alpha * transb(B) * transa(A) ) * t (side = right)
// = beta * C_orig * t + alpha * transb(B) * transa(A) * t
// = beta * C_orig * t + alpha * transb(B) * w
// = beta * C_orig * t + z
bli_obj_scalar_init_detached( dt, &kappa );
bli_obj_scalar_init_detached( dt_real, &norm );
if ( bli_is_left( side ) )
{
bli_obj_create( dt, n, 1, 0, 0, &t );
bli_obj_create( dt, m, 1, 0, 0, &v );
bli_obj_create( dt, m, 1, 0, 0, &w );
bli_obj_create( dt, m, 1, 0, 0, &z );
}
else // else if ( bli_is_left( side ) )
{
bli_obj_create( dt, n, 1, 0, 0, &t );
bli_obj_create( dt, m, 1, 0, 0, &v );
bli_obj_create( dt, n, 1, 0, 0, &w );
bli_obj_create( dt, m, 1, 0, 0, &z );
}
bli_randv( &t );
bli_setsc( 1.0/( double )n, 0.0, &kappa );
bli_scalv( &kappa, &t );
bli_gemv( &BLIS_ONE, c, &t, &BLIS_ZERO, &v );
if ( bli_is_left( side ) )
{
bli_gemv( &BLIS_ONE, b, &t, &BLIS_ZERO, &w );
bli_trmv( alpha, a, &w );
bli_copyv( &w, &z );
}
else
{
bli_copyv( &t, &w );
bli_trmv( &BLIS_ONE, a, &w );
bli_gemv( alpha, b, &w, &BLIS_ZERO, &z );
}
bli_gemv( beta, c_orig, &t, &BLIS_ONE, &z );
bli_subv( &z, &v );
bli_fnormv( &v, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &t );
bli_obj_free( &v );
bli_obj_free( &w );
bli_obj_free( &z );
}
