void libblis_test_hemv_impl( iface_t iface,
obj_t* alpha,
obj_t* a,
obj_t* x,
obj_t* beta,
obj_t* y )
{
switch ( iface )
{
case BLIS_TEST_SEQ_FRONT_END:
bli_hemv( alpha, a, x, beta, y );
break;
default:
libblis_test_printf_error( "Invalid interface type.\n" );
}
}
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_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_hemm_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 Hermitian.
// - 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 * conja(A) * transb(B) (side = left)
// C := beta * C_orig + alpha * transb(B) * conja(A) (side = right)
//
// is functioning correctly if
//
// normf( v - z )
//
// is negligible, where
//
// v = C * t
//
// z = ( beta * C_orig + alpha * conja(A) * transb(B) ) * t (side = left)
// = beta * C_orig * t + alpha * conja(A) * transb(B) * t
// = beta * C_orig * t + alpha * conja(A) * w
// = beta * C_orig * t + z
//
// z = ( beta * C_orig + alpha * transb(B) * conja(A) ) * t (side = right)
// = beta * C_orig * t + alpha * transb(B) * conja(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_right( 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_hemv( alpha, a, &w, &BLIS_ZERO, &z );
}
else // else if ( bli_is_right( side ) )
{
bli_hemv( &BLIS_ONE, a, &t, &BLIS_ZERO, &w );
bli_gemv( alpha, b, &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 );
}
