void libblis_test_trsv_impl( mt_impl_t impl,
obj_t* alpha,
obj_t* a,
obj_t* x )
{
switch ( impl )
{
case BLIS_TEST_SEQ_FRONT_END:
bli_trsv( alpha, a, x );
break;
default:
libblis_test_printf_error( "Invalid implementation type.\n" );
}
}
void libblis_test_trsv_impl
(
iface_t iface,
obj_t* alpha,
obj_t* a,
obj_t* x
)
{
switch ( iface )
{
case BLIS_TEST_SEQ_FRONT_END:
bli_trsv( alpha, a, x );
break;
default:
libblis_test_printf_error( "Invalid interface type.\n" );
}
}
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_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 );
}
int main( int argc, char** argv )
{
obj_t a, x;
obj_t x_save;
obj_t alpha;
dim_t m;
dim_t p;
dim_t p_begin, p_end, p_inc;
int m_input;
num_t dt_a, dt_x;
num_t dt_alpha;
int r, n_repeats;
uplo_t uplo;
double dtime;
double dtime_save;
double gflops;
//bli_init();
n_repeats = 3;
#ifndef PRINT
p_begin = 40;
p_end = 2000;
p_inc = 40;
m_input = -1;
#else
p_begin = 16;
p_end = 16;
p_inc = 1;
m_input = 15;
n_input = 15;
#endif
dt_alpha = dt_a = dt_x = BLIS_DOUBLE;
uplo = BLIS_LOWER;
// Begin with initializing the last entry to zero so that
// matlab allocates space for the entire array once up-front.
for ( p = p_begin; p + p_inc <= p_end; p += p_inc ) ;
#ifdef BLIS
printf( "data_trsv_blis" );
#else
printf( "data_trv_%s", BLAS );
#endif
printf( "( %2lu, 1:2 ) = [ %4lu %7.2f ];\n",
( unsigned long )(p - p_begin + 1)/p_inc + 1,
( unsigned long )0, 0.0 );
for ( p = p_begin; p <= p_end; p += p_inc )
{
if ( m_input < 0 ) m = p * ( dim_t )abs(m_input);
else m = ( dim_t ) m_input;
bli_obj_create( dt_alpha, 1, 1, 0, 0, &alpha );
bli_obj_create( dt_a, m, m, 0, 0, &a );
bli_obj_create( dt_x, m, 1, 0, 0, &x );
bli_obj_create( dt_x, m, 1, 0, 0, &x_save );
bli_randm( &a );
bli_randm( &x );
bli_obj_set_struc( BLIS_TRIANGULAR, &a );
bli_obj_set_uplo( uplo, &a );
bli_obj_set_onlytrans( BLIS_NO_TRANSPOSE, &a );
bli_obj_set_diag( BLIS_NONUNIT_DIAG, &a );
// Randomize A and zero the unstored triangle to ensure the
// implementation reads only from the stored region.
bli_randm( &a );
bli_mktrim( &a );
// Load the diagonal of A to make it more likely to be invertible.
bli_shiftd( &BLIS_TWO, &a );
bli_setsc( (1.0/1.0), 0.0, &alpha );
bli_copym( &x, &x_save );
dtime_save = DBL_MAX;
for ( r = 0; r < n_repeats; ++r )
{
bli_copym( &x_save, &x );
dtime = bli_clock();
#ifdef PRINT
bli_printm( "a", &a, "%4.1f", "" );
bli_printm( "x", &x, "%4.1f", "" );
#endif
#ifdef BLIS
bli_trsv( &BLIS_ONE,
&a,
&x );
#else
f77_char uploa = 'L';
f77_char transa = 'N';
f77_char diaga = 'N';
f77_int mm = bli_obj_length( &a );
f77_int lda = bli_obj_col_stride( &a );
f77_int incx = bli_obj_vector_inc( &x );
double* ap = bli_obj_buffer( &a );
double* xp = bli_obj_buffer( &x );
dtrsv_( &uploa,
&transa,
&diaga,
&mm,
ap, &lda,
xp, &incx );
#endif
#ifdef PRINT
bli_printm( "x after", &x, "%4.1f", "" );
exit(1);
#endif
dtime_save = bli_clock_min_diff( dtime_save, dtime );
}
gflops = ( 1.0 * m * m ) / ( dtime_save * 1.0e9 );
#ifdef BLIS
printf( "data_trsv_blis" );
#else
printf( "data_trsv_%s", BLAS );
#endif
printf( "( %2lu, 1:2 ) = [ %4lu %7.2f ];\n",
( unsigned long )(p - p_begin + 1)/p_inc + 1,
( unsigned long )m, gflops );
bli_obj_free( &alpha );
bli_obj_free( &a );
bli_obj_free( &x );
bli_obj_free( &x_save );
}
//bli_finalize();
return 0;
}
