Пример #1
0
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 );
}
Пример #2
0
//
// Define object-based interface.
//
void bli_trsm( side_t  side,
               obj_t*  alpha,
               obj_t*  a,
               obj_t*  b )
{
	if (
#ifdef BLIS_ENABLE_SCOMPLEX_VIA_4M
	     bli_obj_is_scomplex( *b ) ||
#endif
#ifdef BLIS_ENABLE_DCOMPLEX_VIA_4M
	     bli_obj_is_dcomplex( *b ) ||
#endif
	     FALSE
	   )
		return bli_trsm4m( side, alpha, a, b );

	bli_trsm_front( side, alpha, a, b,
	                trsm_l_cntl,
	                trsm_r_cntl );
}
Пример #3
0
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 );
}
Пример #4
0
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;
		}
	}
}
Пример #5
0
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;
	}
}
Пример #6
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;
	}
}
Пример #7
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; }
			}
		}
	}
}