Пример #1
0
err_t bli_check_conformal_dims( obj_t* a, obj_t* b )
{
	err_t e_val = BLIS_SUCCESS;
	dim_t m_a, n_a;
	dim_t m_b, n_b;

	m_a = bli_obj_length_after_trans( *a );
	n_a = bli_obj_width_after_trans( *a );
	m_b = bli_obj_length_after_trans( *b );
	n_b = bli_obj_width_after_trans( *b );

	if ( m_a != m_b || n_a != n_b )
		e_val = BLIS_NONCONFORMAL_DIMENSIONS;

	return e_val;
}
Пример #2
0
void bli_axpyf_check( obj_t*  alpha,
                      obj_t*  a,
                      obj_t*  x,
                      obj_t*  y )
{
	err_t e_val;

	// Check object datatypes.

	e_val = bli_check_noninteger_object( alpha );
	bli_check_error_code( e_val );

	e_val = bli_check_floating_object( a );
	bli_check_error_code( e_val );

	e_val = bli_check_floating_object( x );
	bli_check_error_code( e_val );

	e_val = bli_check_floating_object( y );
	bli_check_error_code( e_val );

	// Check object dimensions.

	e_val = bli_check_scalar_object( alpha );
	bli_check_error_code( e_val );

	e_val = bli_check_matrix_object( a );
	bli_check_error_code( e_val );

	e_val = bli_check_vector_object( x );
	bli_check_error_code( e_val );

	e_val = bli_check_vector_object( y );
	bli_check_error_code( e_val );

	e_val = bli_check_vector_dim_equals( x, bli_obj_width_after_trans( *a ) );
	bli_check_error_code( e_val );

	e_val = bli_check_vector_dim_equals( y, bli_obj_length_after_trans( *a ) );
	bli_check_error_code( e_val );

	// Check object buffers (for non-NULLness).

	e_val = bli_check_object_buffer( alpha );
	bli_check_error_code( e_val );

	e_val = bli_check_object_buffer( a );
	bli_check_error_code( e_val );

	e_val = bli_check_object_buffer( x );
	bli_check_error_code( e_val );

	e_val = bli_check_object_buffer( y );
	bli_check_error_code( e_val );
}
Пример #3
0
err_t bli_check_level3_dims( obj_t* a, obj_t* b, obj_t* c )
{
	err_t e_val = BLIS_SUCCESS;
	dim_t m_c, n_c;
	dim_t m_a, k_a;
	dim_t k_b, n_b;

	m_c = bli_obj_length_after_trans( *c );
	n_c = bli_obj_width_after_trans( *c );

	m_a = bli_obj_length_after_trans( *a );
	k_a = bli_obj_width_after_trans( *a );

	k_b = bli_obj_length_after_trans( *b );
	n_b = bli_obj_width_after_trans( *b );

	if ( m_c != m_a ||
	     n_c != n_b ||
	     k_a != k_b )
		e_val = BLIS_NONCONFORMAL_DIMENSIONS;

	return e_val;
}
Пример #4
0
void blx_gemm_blk_var3
     (
       obj_t*  a,
       obj_t*  b,
       obj_t*  c,
       cntx_t* cntx,
       rntm_t* rntm,
       cntl_t* cntl,
       thrinfo_t* thread
     )
{
	obj_t a1, b1;
	dim_t i;
	dim_t b_alg;
	dim_t k_trans;

	// Query dimension in partitioning direction.
	k_trans = bli_obj_width_after_trans( a );

	// Partition along the k dimension.
	for ( i = 0; i < k_trans; i += b_alg )
	{
		// Determine the current algorithmic blocksize.
		b_alg = blx_determine_blocksize_f( i, k_trans, c,
		                                   bli_cntl_bszid( cntl ), cntx );

		// Acquire partitions for A1 and B1.
		bli_acquire_mpart_ndim( BLIS_FWD, BLIS_SUBPART1, i, b_alg, a, &a1 );
		bli_acquire_mpart_mdim( BLIS_FWD, BLIS_SUBPART1, i, b_alg, b, &b1 );

		// Perform gemm subproblem.
		blx_gemm_int
		(
		  &a1, &b1, c, cntx, rntm,
		  bli_cntl_sub_node( cntl ),
		  bli_thrinfo_sub_node( thread )
		);

		bli_thread_obarrier( bli_thrinfo_sub_node( thread ) );

		// This variant executes multiple rank-k updates. Therefore, if the
		// internal beta scalar on matrix C is non-zero, we must use it
		// only for the first iteration (and then BLIS_ONE for all others).
		// And since c is a locally aliased obj_t, we can simply overwrite
		// the internal beta scalar with BLIS_ONE once it has been used in
		// the first iteration. 
		if ( i == 0 ) bli_obj_scalar_reset( c );
	}
}
Пример #5
0
void bli_gemv_basic_check( obj_t*  alpha,
                           obj_t*  a,
                           obj_t*  x,
                           obj_t*  beta,
                           obj_t*  y )
{
	err_t e_val;

	// Check object datatypes.

	e_val = bli_check_noninteger_object( alpha );
	bli_check_error_code( e_val );

	e_val = bli_check_noninteger_object( beta );
	bli_check_error_code( e_val );

	e_val = bli_check_floating_object( a );
	bli_check_error_code( e_val );

	e_val = bli_check_floating_object( x );
	bli_check_error_code( e_val );

	e_val = bli_check_floating_object( y );
	bli_check_error_code( e_val );

	// Check object dimensions.

	e_val = bli_check_scalar_object( alpha );
	bli_check_error_code( e_val );

	e_val = bli_check_scalar_object( beta );
	bli_check_error_code( e_val );

	e_val = bli_check_vector_object( x );
	bli_check_error_code( e_val );

	e_val = bli_check_vector_object( y );
	bli_check_error_code( e_val );

	e_val = bli_check_vector_dim_equals( x, bli_obj_width_after_trans( *a ) );
	bli_check_error_code( e_val );

	e_val = bli_check_vector_dim_equals( y, bli_obj_length_after_trans( *a ) );
	bli_check_error_code( e_val );
}
Пример #6
0
siz_t bli_thread_get_range_l2r
     (
       thrinfo_t* thr,
       obj_t*     a,
       blksz_t*   bmult,
       dim_t*     start,
       dim_t*     end
     )
{
	dim_t m  = bli_obj_length_after_trans( *a );
	dim_t n  = bli_obj_width_after_trans( *a );
	dim_t bf = bli_blksz_get_def_for_obj( a, bmult );

	bli_thread_get_range_sub( thr, n, bf,
	                          FALSE, start, end );

	return m * ( *end - *start );
}
Пример #7
0
siz_t bli_thread_get_range_b2t
     (
       thrinfo_t* thr,
       obj_t*     a,
       blksz_t*   bmult,
       dim_t*     start,
       dim_t*     end
     )
{
	dim_t m  = bli_obj_length_after_trans( *a );
	dim_t n  = bli_obj_width_after_trans( *a );
	dim_t bf = bli_blksz_get_def_for_obj( a, bmult );

	bli_thread_get_range( thr, m, bf,
	                      TRUE, start, end );

	return n * ( *end - *start );
}
Пример #8
0
int main( int argc, char** argv )
{
	obj_t a, b, c;
	obj_t c_save;
	obj_t alpha, beta;
	dim_t m, n, k;
	dim_t p;
	dim_t p_begin, p_end, p_inc;
	int   m_input, n_input, k_input;
	num_t dt_a, dt_b, dt_c;
	num_t dt_alpha, dt_beta;
	int   r, n_repeats;

	double dtime;
	double dtime_save;
	double gflops;

    
    int world_size, world_rank, provided;
    MPI_Init_thread( NULL, NULL, MPI_THREAD_FUNNELED, &provided );
    MPI_Comm_size( MPI_COMM_WORLD, &world_size );
    MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );

	bli_init();

	n_repeats = 3;

#ifndef PRINT
	p_begin = 16;
	p_end   = 2048;
	p_inc   = 16;

	m_input = 10240;
	n_input = 10240;
	k_input = -1;
#else
	p_begin = 24;
	p_end   = 24;
	p_inc   = 1;

	m_input = -1;
	k_input = -1;
	n_input = -1;
#endif

	dt_a = BLIS_DOUBLE;
	dt_b = BLIS_DOUBLE;
	dt_c = BLIS_DOUBLE;
	dt_alpha = BLIS_DOUBLE;
	dt_beta = BLIS_DOUBLE;

	for ( p = p_begin + world_rank * p_inc ; p <= p_end; p += p_inc * world_size )
	{

		if ( m_input < 0 ) m = p * ( dim_t )abs(m_input);
		else               m =     ( dim_t )    m_input;
		if ( n_input < 0 ) n = p * ( dim_t )abs(n_input);
		else               n =     ( dim_t )    n_input;
		if ( k_input < 0 ) k = p * ( dim_t )abs(k_input);
		else               k =     ( dim_t )    k_input;


		bli_obj_create( dt_alpha, 1, 1, 0, 0, &alpha );
		bli_obj_create( dt_beta,  1, 1, 0, 0, &beta );

		bli_obj_create( dt_a, m, k, 0, 0, &a );
		bli_obj_create( dt_b, k, n, 0, 0, &b );
		bli_obj_create( dt_c, m, n, 0, 0, &c );
		bli_obj_create( dt_c, m, n, 0, 0, &c_save );

		bli_randm( &a );
		bli_randm( &b );
		bli_randm( &c );


		bli_setsc(  (1.0/1.0), 0.0, &alpha );
		bli_setsc(  (1.0/1.0), 0.0, &beta );

		bli_copym( &c, &c_save );
	
		dtime_save = 1.0e9;

		for ( r = 0; r < n_repeats; ++r )
		{
			bli_copym( &c_save, &c );


			dtime = bli_clock();


#ifdef PRINT
			bli_printm( "a", &a, "%4.1f", "" );
			bli_printm( "b", &b, "%4.1f", "" );
			bli_printm( "c", &c, "%4.1f", "" );
#endif

#ifdef BLIS
			//bli_error_checking_level_set( BLIS_NO_ERROR_CHECKING );
            {
                bli_gemm( &alpha,
                          &a,
                          &b,
                          &beta,
                          &c );
            }

#else
			char    transa = 'N';
			char    transb = 'N';
			int     mm     = bli_obj_length( c );
			int     kk     = bli_obj_width_after_trans( a );
			int     nn     = bli_obj_width( c );
			int     lda    = bli_obj_col_stride( a );
			int     ldb    = bli_obj_col_stride( b );
			int     ldc    = bli_obj_col_stride( c );
			double* alphap = bli_obj_buffer( alpha );
			double* ap     = bli_obj_buffer( a );
			double* bp     = bli_obj_buffer( b );
			double* betap  = bli_obj_buffer( beta );
			double* cp     = bli_obj_buffer( c );

			dgemm_( &transa,
			        &transb,
			        &mm,
			        &nn,
			        &kk,
			        alphap,
			        ap, &lda,
			        bp, &ldb,
			        betap,
			        cp, &ldc );
            
#endif

#ifdef PRINT
			bli_printm( "c after", &c, "%4.1f", "" );
			exit(1);
#endif


			dtime_save = bli_clock_min_diff( dtime_save, dtime );
		}
		
        gflops = ( 2.0 * m * k * n ) / ( dtime_save * 1.0e9 );

        //if(world_rank == 0){
#ifdef BLIS
            printf( "data_gemm_blis" );
#else
            printf( "data_gemm_%s", BLAS );
#endif
            printf( "( %2ld, 1:5 ) = [ %4lu %4lu %4lu  %10.3e  %6.3f %d ];\n",
                    (p - p_begin + 1)/p_inc + 1, m, k, n, dtime_save, gflops, world_rank );
        //}
    
        bli_obj_free( &alpha );
        bli_obj_free( &beta );

        bli_obj_free( &a );
        bli_obj_free( &b );
        bli_obj_free( &c );
        bli_obj_free( &c_save );
	}

	bli_finalize();

    MPI_Finalize();

	return 0;
}
Пример #9
0
int main( int argc, char** argv )
{
    obj_t a, b, c;
    obj_t x, y;
    obj_t alpha, beta;
    dim_t m;
    num_t dt_a, dt_b, dt_c;
    num_t dt_alpha, dt_beta;
    int   ii;

#ifdef NBLIS
    bli_init();
#endif


    m = 4000;

    dt_a = BLIS_DOUBLE;
    dt_b = BLIS_DOUBLE;
    dt_c = BLIS_DOUBLE;
    dt_alpha = BLIS_DOUBLE;
    dt_beta = BLIS_DOUBLE;

    {


#ifdef NBLIS
        bli_obj_create( dt_alpha, 1, 1, 0, 0, &alpha );
        bli_obj_create( dt_beta,  1, 1, 0, 0, &beta );

        bli_obj_create( dt_a, m, 1, 0, 0, &x );
        bli_obj_create( dt_a, m, 1, 0, 0, &y );

        bli_obj_create( dt_a, m, m, 0, 0, &a );
        bli_obj_create( dt_b, m, m, 0, 0, &b );
        bli_obj_create( dt_c, m, m, 0, 0, &c );

        bli_randm( &a );
        bli_randm( &b );
        bli_randm( &c );

        bli_setsc(  (2.0/1.0), 0.0, &alpha );
        bli_setsc( -(1.0/1.0), 0.0, &beta );

#endif

#ifdef NBLAS
        x.buffer     = malloc( m * 1 * sizeof( double ) );
        y.buffer     = malloc( m * 1 * sizeof( double ) );

        alpha.buffer = malloc( 1 * sizeof( double ) );
        beta.buffer  = malloc( 1 * sizeof( double ) );
        a.buffer     = malloc( m * m * sizeof( double ) );
        a.m          = m;
        a.n          = m;
        a.cs         = m;
        b.buffer     = malloc( m * m * sizeof( double ) );
        b.m          = m;
        b.n          = m;
        b.cs         = m;
        c.buffer     = malloc( m * m * sizeof( double ) );
        c.m          = m;
        c.n          = m;
        c.cs         = m;

        *((double*)alpha.buffer) =  2.0;
        *((double*)beta.buffer)  = -1.0;
#endif


#ifdef NBLIS

#if NBLIS >= 1
        for ( ii = 0; ii < 2000000000; ++ii )
        {
            bli_gemm( &BLIS_ONE,
                      &a,
                      &b,
                      &BLIS_ONE,
                      &c );
        }
#endif

#if NBLIS >= 2
        {
            bli_hemm( BLIS_LEFT,
                      &BLIS_ONE,
                      &a,
                      &b,
                      &BLIS_ONE,
                      &c );
        }
#endif

#if NBLIS >= 3
        {
            bli_herk( &BLIS_ONE,
                      &a,
                      &BLIS_ONE,
                      &c );
        }
#endif

#if NBLIS >= 4
        {
            bli_her2k( &BLIS_ONE,
                       &a,
                       &b,
                       &BLIS_ONE,
                       &c );
        }
#endif

#if NBLIS >= 5
        {
            bli_trmm( BLIS_LEFT,
                      &BLIS_ONE,
                      &a,
                      &c );
        }
#endif

#if NBLIS >= 6
        {
            bli_trsm( BLIS_LEFT,
                      &BLIS_ONE,
                      &a,
                      &c );
        }
#endif

#endif



#ifdef NBLAS

#if NBLAS >= 1
        for ( ii = 0; ii < 2000000000; ++ii )
        {
            f77_char transa = 'N';
            f77_char transb = 'N';
            f77_int  mm     = bli_obj_length( c );
            f77_int  kk     = bli_obj_width_after_trans( a );
            f77_int  nn     = bli_obj_width( c );
            f77_int  lda    = bli_obj_col_stride( a );
            f77_int  ldb    = bli_obj_col_stride( b );
            f77_int  ldc    = bli_obj_col_stride( c );
            double*  alphap = bli_obj_buffer( alpha );
            double*  ap     = bli_obj_buffer( a );
            double*  bp     = bli_obj_buffer( b );
            double*  betap  = bli_obj_buffer( beta );
            double*  cp     = bli_obj_buffer( c );

            dgemm_( &transa,
                    &transb,
                    &mm,
                    &nn,
                    &kk,
                    alphap,
                    ap, &lda,
                    bp, &ldb,
                    betap,
                    cp, &ldc );
        }
#endif

#if NBLAS >= 2
        {
            f77_char side   = 'L';
            f77_char uplo   = 'L';
            f77_int  mm     = bli_obj_length( c );
            f77_int  nn     = bli_obj_width( c );
            f77_int  lda    = bli_obj_col_stride( a );
            f77_int  ldb    = bli_obj_col_stride( b );
            f77_int  ldc    = bli_obj_col_stride( c );
            double*  alphap = bli_obj_buffer( alpha );
            double*  ap     = bli_obj_buffer( a );
            double*  bp     = bli_obj_buffer( b );
            double*  betap  = bli_obj_buffer( beta );
            double*  cp     = bli_obj_buffer( c );

            dsymm_( &side,
                    &uplo,
                    &mm,
                    &nn,
                    alphap,
                    ap, &lda,
                    bp, &ldb,
                    betap,
                    cp, &ldc );
        }
#endif

#if NBLAS >= 3
        {
            f77_char uplo   = 'L';
            f77_char trans  = 'N';
            f77_int  mm     = bli_obj_length( c );
            f77_int  kk     = bli_obj_width( a );
            f77_int  lda    = bli_obj_col_stride( a );
            f77_int  ldc    = bli_obj_col_stride( c );
            double*  alphap = bli_obj_buffer( alpha );
            double*  ap     = bli_obj_buffer( a );
            double*  betap  = bli_obj_buffer( beta );
            double*  cp     = bli_obj_buffer( c );

            dsyrk_( &uplo,
                    &trans,
                    &mm,
                    &kk,
                    alphap,
                    ap, &lda,
                    betap,
                    cp, &ldc );
        }
#endif

#if NBLAS >= 4
        {
            f77_char uplo   = 'L';
            f77_char trans  = 'N';
            f77_int  mm     = bli_obj_length( c );
            f77_int  kk     = bli_obj_width( a );
            f77_int  lda    = bli_obj_col_stride( a );
            f77_int  ldb    = bli_obj_col_stride( b );
            f77_int  ldc    = bli_obj_col_stride( c );
            double*  alphap = bli_obj_buffer( alpha );
            double*  ap     = bli_obj_buffer( a );
            double*  bp     = bli_obj_buffer( b );
            double*  betap  = bli_obj_buffer( beta );
            double*  cp     = bli_obj_buffer( c );

            dsyr2k_( &uplo,
                     &trans,
                     &mm,
                     &kk,
                     alphap,
                     ap, &lda,
                     bp, &ldb,
                     betap,
                     cp, &ldc );
        }
#endif

#if NBLAS >= 5
        {
            f77_char side   = 'L';
            f77_char uplo   = 'L';
            f77_char trans  = 'N';
            f77_char diag   = 'N';
            f77_int  mm     = bli_obj_length( c );
            f77_int  nn     = bli_obj_width( c );
            f77_int  lda    = bli_obj_col_stride( a );
            f77_int  ldc    = bli_obj_col_stride( c );
            double*  alphap = bli_obj_buffer( alpha );
            double*  ap     = bli_obj_buffer( a );
            double*  cp     = bli_obj_buffer( c );

            dtrmm_( &side,
                    &uplo,
                    &trans,
                    &diag,
                    &mm,
                    &nn,
                    alphap,
                    ap, &lda,
                    cp, &ldc );
        }
#endif

#if NBLAS >= 6
        {
            f77_char side   = 'L';
            f77_char uplo   = 'L';
            f77_char trans  = 'N';
            f77_char diag   = 'N';
            f77_int  mm     = bli_obj_length( c );
            f77_int  nn     = bli_obj_width( c );
            f77_int  lda    = bli_obj_col_stride( a );
            f77_int  ldc    = bli_obj_col_stride( c );
            double*  alphap = bli_obj_buffer( alpha );
            double*  ap     = bli_obj_buffer( a );
            double*  cp     = bli_obj_buffer( c );

            dtrsm_( &side,
                    &uplo,
                    &trans,
                    &diag,
                    &mm,
                    &nn,
                    alphap,
                    ap, &lda,
                    cp, &ldc );
        }
#endif

#if NBLAS >= 7
        {
            f77_char  transa = 'N';
            f77_char  transb = 'N';
            f77_int   mm     = bli_obj_length( c );
            f77_int   kk     = bli_obj_width_after_trans( a );
            f77_int   nn     = bli_obj_width( c );
            f77_int   lda    = bli_obj_col_stride( a );
            f77_int   ldb    = bli_obj_col_stride( b );
            f77_int   ldc    = bli_obj_col_stride( c );
            dcomplex* alphap = bli_obj_buffer( alpha );
            dcomplex* ap     = bli_obj_buffer( a );
            dcomplex* bp     = bli_obj_buffer( b );
            dcomplex* betap  = bli_obj_buffer( beta );
            dcomplex* cp     = bli_obj_buffer( c );

            zgemm_( &transa,
                    &transb,
                    &mm,
                    &nn,
                    &kk,
                    alphap,
                    ap, &lda,
                    bp, &ldb,
                    betap,
                    cp, &ldc );
        }
#endif

#if NBLAS >= 8
        {
            f77_char  side   = 'L';
            f77_char  uplo   = 'L';
            f77_int   mm     = bli_obj_length( c );
            f77_int   nn     = bli_obj_width( c );
            f77_int   lda    = bli_obj_col_stride( a );
            f77_int   ldb    = bli_obj_col_stride( b );
            f77_int   ldc    = bli_obj_col_stride( c );
            dcomplex* alphap = bli_obj_buffer( alpha );
            dcomplex* ap     = bli_obj_buffer( a );
            dcomplex* bp     = bli_obj_buffer( b );
            dcomplex* betap  = bli_obj_buffer( beta );
            dcomplex* cp     = bli_obj_buffer( c );

            zhemm_( &side,
                    &uplo,
                    &mm,
                    &nn,
                    alphap,
                    ap, &lda,
                    bp, &ldb,
                    betap,
                    cp, &ldc );
        }
#endif

#if NBLAS >= 9
        {
            f77_char  uplo   = 'L';
            f77_char  trans  = 'N';
            f77_int   mm     = bli_obj_length( c );
            f77_int   kk     = bli_obj_width( a );
            f77_int   lda    = bli_obj_col_stride( a );
            f77_int   ldc    = bli_obj_col_stride( c );
            double*   alphap = bli_obj_buffer( alpha );
            dcomplex* ap     = bli_obj_buffer( a );
            double*   betap  = bli_obj_buffer( beta );
            dcomplex* cp     = bli_obj_buffer( c );

            zherk_( &uplo,
                    &trans,
                    &mm,
                    &kk,
                    alphap,
                    ap, &lda,
                    betap,
                    cp, &ldc );
        }
#endif

#if NBLAS >= 10
        {
            f77_char  uplo   = 'L';
            f77_char  trans  = 'N';
            f77_int   mm     = bli_obj_length( c );
            f77_int   kk     = bli_obj_width( a );
            f77_int   lda    = bli_obj_col_stride( a );
            f77_int   ldb    = bli_obj_col_stride( b );
            f77_int   ldc    = bli_obj_col_stride( c );
            dcomplex* alphap = bli_obj_buffer( alpha );
            dcomplex* ap     = bli_obj_buffer( a );
            dcomplex* bp     = bli_obj_buffer( b );
            double*   betap  = bli_obj_buffer( beta );
            dcomplex* cp     = bli_obj_buffer( c );

            zher2k_( &uplo,
                     &trans,
                     &mm,
                     &kk,
                     alphap,
                     ap, &lda,
                     bp, &ldb,
                     betap,
                     cp, &ldc );
        }
#endif

#if NBLAS >= 11
        {
            f77_char  side   = 'L';
            f77_char  uplo   = 'L';
            f77_char  trans  = 'N';
            f77_char  diag   = 'N';
            f77_int   mm     = bli_obj_length( c );
            f77_int   nn     = bli_obj_width( c );
            f77_int   lda    = bli_obj_col_stride( a );
            f77_int   ldc    = bli_obj_col_stride( c );
            dcomplex* alphap = bli_obj_buffer( alpha );
            dcomplex* ap     = bli_obj_buffer( a );
            dcomplex* cp     = bli_obj_buffer( c );

            ztrmm_( &side,
                    &uplo,
                    &trans,
                    &diag,
                    &mm,
                    &nn,
                    alphap,
                    ap, &lda,
                    cp, &ldc );
        }
#endif

#if NBLAS >= 12
        {
            f77_char  side   = 'L';
            f77_char  uplo   = 'L';
            f77_char  trans  = 'N';
            f77_char  diag   = 'N';
            f77_int   mm     = bli_obj_length( c );
            f77_int   nn     = bli_obj_width( c );
            f77_int   lda    = bli_obj_col_stride( a );
            f77_int   ldc    = bli_obj_col_stride( c );
            dcomplex* alphap = bli_obj_buffer( alpha );
            dcomplex* ap     = bli_obj_buffer( a );
            dcomplex* cp     = bli_obj_buffer( c );

            ztrsm_( &side,
                    &uplo,
                    &trans,
                    &diag,
                    &mm,
                    &nn,
                    alphap,
                    ap, &lda,
                    cp, &ldc );
        }
#endif


#endif


#ifdef NBLIS
        bli_obj_free( &x );
        bli_obj_free( &y );

        bli_obj_free( &alpha );
        bli_obj_free( &beta );

        bli_obj_free( &a );
        bli_obj_free( &b );
        bli_obj_free( &c );
#endif

#ifdef NBLAS
        free( x.buffer );
        free( y.buffer );

        free( alpha.buffer );
        free( beta.buffer );

        free( a.buffer );
        free( b.buffer );
        free( c.buffer );
#endif
    }

#ifdef NBLIS
    bli_finalize();
#endif

    return 0;
}
Пример #10
0
void bli_trmm_lu_blk_var4( obj_t*  alpha,
                           obj_t*  a,
                           obj_t*  b,
                           obj_t*  beta,
                           obj_t*  c,
                           trmm_t* cntl )
{
    obj_t a1, a1_pack;
    obj_t b_pack;
    obj_t c1, c1_pack;

    dim_t i;
    dim_t bm_alg;
    dim_t mT_trans;

    // Initialize all pack objects that are passed into packm_init().
    bli_obj_init_pack( &a1_pack );
    bli_obj_init_pack( &b_pack );
    bli_obj_init_pack( &c1_pack );

    // Query dimension in partitioning direction. Use the diagonal offset
    // to stop short of the zero region.
    mT_trans = bli_abs( bli_obj_diag_offset_after_trans( *a ) ) +
               bli_obj_width_after_trans( *a );

    // Scale C by beta (if instructed).
    bli_scalm_int( beta,
                   c,
                   cntl_sub_scalm( cntl ) );

    // Initialize object for packing B.
    bli_packm_init( b, &b_pack,
                    cntl_sub_packm_b( cntl ) );

    // Fuse the first iteration with incremental packing and computation.
    {
        obj_t b_inc, b_pack_inc;
        obj_t c1_pack_inc;

        dim_t j;
        dim_t bn_inc;
        dim_t n_trans;

        // Query dimension in partitioning direction.
        n_trans = bli_obj_width( b_pack );

        // Determine the current algorithmic blocksize.
        bm_alg = bli_determine_blocksize_f( 0, mT_trans, a,
                                            cntl_blocksize( cntl ) );

        // Acquire partitions for A1 and C1.
        bli_acquire_mpart_t2b( BLIS_SUBPART1,
                               0, bm_alg, a, &a1 );
        bli_acquire_mpart_t2b( BLIS_SUBPART1,
                               0, bm_alg, c, &c1 );

        // Initialize objects for packing A1 and C1.
        bli_packm_init( &a1, &a1_pack, cntl_sub_packm_a( cntl ) );
        bli_packm_init( &c1, &c1_pack, cntl_sub_packm_c( cntl ) );

        // Pack A1 and scale by alpha (if instructed).
        bli_packm_int( alpha, &a1, &a1_pack, cntl_sub_packm_a( cntl ) );

        // Pack C1 and scale by beta (if instructed).
        bli_packm_int( beta,  &c1, &c1_pack, cntl_sub_packm_c( cntl ) );

        // Partition along the n dimension.
        for ( j = 0; j < n_trans; j += bn_inc )
        {
            // Determine the current incremental packing blocksize.
            bn_inc = bli_determine_blocksize_f( j, n_trans, b,
                                                cntl_blocksize_aux( cntl ) );

            // Acquire partitions.
            bli_acquire_mpart_l2r( BLIS_SUBPART1,
                                   j, bn_inc, b, &b_inc );
            bli_acquire_mpart_l2r( BLIS_SUBPART1,
                                   j, bn_inc, &b_pack, &b_pack_inc );
            bli_acquire_mpart_l2r( BLIS_SUBPART1,
                                   j, bn_inc, &c1_pack, &c1_pack_inc );

            // Pack B1 and scale by alpha (if instructed).
            bli_packm_int( alpha, &b_inc, &b_pack_inc, cntl_sub_packm_b( cntl ) );

            // Perform trmm subproblem.
            bli_trmm_int( BLIS_LEFT,
                          alpha,
                          &a1_pack,
                          &b_pack_inc,
                          beta,
                          &c1_pack_inc,
                          cntl_sub_trmm( cntl ) );
        }

        // Unpack C1 (if C1 was packed).
        bli_unpackm_int( &c1_pack, &c1, cntl_sub_unpackm_c( cntl ) );
    }


    // Partition along the remaining portion of the m dimension.
    for ( i = bm_alg; i < mT_trans; i += bm_alg )
    {
        // Determine the current algorithmic blocksize.
        bm_alg = bli_determine_blocksize_f( i, mT_trans, a,
                                            cntl_blocksize( cntl ) );

        // Acquire partitions for A1 and C1.
        bli_acquire_mpart_t2b( BLIS_SUBPART1,
                               i, bm_alg, a, &a1 );
        bli_acquire_mpart_t2b( BLIS_SUBPART1,
                               i, bm_alg, c, &c1 );

        // Initialize objects for packing A1 and C1.
        bli_packm_init( &a1, &a1_pack,
                        cntl_sub_packm_a( cntl ) );
        bli_packm_init( &c1, &c1_pack,
                        cntl_sub_packm_c( cntl ) );

        // Pack A1 and scale by alpha (if instructed).
        bli_packm_int( alpha,
                       &a1, &a1_pack,
                       cntl_sub_packm_a( cntl ) );

        // Pack C1 and scale by beta (if instructed).
        bli_packm_int( beta,
                       &c1, &c1_pack,
                       cntl_sub_packm_c( cntl ) );

        // Perform trmm subproblem.
        if ( bli_obj_intersects_diag( a1_pack ) )
            bli_trmm_int( BLIS_LEFT,
                          alpha,
                          &a1_pack,
                          &b_pack,
                          beta,
                          &c1_pack,
                          cntl_sub_trmm( cntl ) );
        else
            bli_gemm_int( alpha,
                          &a1_pack,
                          &b_pack,
                          &BLIS_ONE,
                          &c1_pack,
                          cntl_sub_gemm( cntl ) );

        // Unpack C1 (if C1 was packed).
        bli_unpackm_int( &c1_pack, &c1,
                         cntl_sub_unpackm_c( cntl ) );
    }

    // If any packing buffers were acquired within packm, release them back
    // to the memory manager.
    bli_obj_release_pack( &a1_pack );
    bli_obj_release_pack( &b_pack );
    bli_obj_release_pack( &c1_pack );
}
Пример #11
0
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 );
}
Пример #12
0
void bli_gemm_front( obj_t*  alpha,
                     obj_t*  a,
                     obj_t*  b,
                     obj_t*  beta,
                     obj_t*  c,
                     gemm_t* cntl )
{
	obj_t   a_local;
	obj_t   b_local;
	obj_t   c_local;

	// Check parameters.
	if ( bli_error_checking_is_enabled() )
		bli_gemm_check( alpha, a, b, beta, c );

	// If alpha is zero, scale by beta and return.
	if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
	{
		bli_scalm( beta, c );
		return;
	}

	// Alias A, B, and C in case we need to apply transformations.
	bli_obj_alias_to( *a, a_local );
	bli_obj_alias_to( *b, b_local );
	bli_obj_alias_to( *c, c_local );

	// An optimization: If C is stored by rows and the micro-kernel prefers
	// contiguous columns, or if C is stored by columns and the micro-kernel
	// prefers contiguous rows, transpose the entire operation to allow the
	// micro-kernel to access elements of C in its preferred manner.
	if (
	     ( bli_obj_is_row_stored( c_local ) &&
	       bli_func_prefers_contig_cols( bli_obj_datatype( c_local ),
	                                     bli_gemm_cntl_ukrs( cntl ) ) ) ||
	     ( bli_obj_is_col_stored( c_local ) &&
	       bli_func_prefers_contig_rows( bli_obj_datatype( c_local ),
	                                     bli_gemm_cntl_ukrs( cntl ) ) )
	   )
	{
		bli_obj_swap( a_local, b_local );

		bli_obj_induce_trans( a_local );
		bli_obj_induce_trans( b_local );
		bli_obj_induce_trans( c_local );
	}

    gemm_thrinfo_t** infos = bli_create_gemm_thrinfo_paths();
    dim_t n_threads = thread_num_threads( infos[0] );

	// Invoke the internal back-end.
    bli_level3_thread_decorator( n_threads,   
                                 (level3_int_t) bli_gemm_int, 
                                 alpha, 
                                 &a_local,  
                                 &b_local,  
                                 beta, 
                                 &c_local,  
                                 (void*) cntl, 
                                 (void**) infos );

    bli_gemm_thrinfo_free_paths( infos, n_threads );

#ifdef BLIS_ENABLE_FLOP_COUNT
	// Increment the global flop counter.
	bli_flop_count_inc( 2.0 * bli_obj_length( *c )
	                        * bli_obj_width( *c )
	                        * bli_obj_width_after_trans( a_local )
	                        * ( bli_obj_is_complex( *c ) ? 4.0 : 1.0 ) );
#endif
}
Пример #13
0
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 );
}
Пример #14
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 );
}
Пример #15
0
void bli_gemm_blk_var3f( obj_t*  a,
                         obj_t*  b,
                         obj_t*  c,
                         gemm_t* cntl )
{
	obj_t  a1, a1_pack;
	obj_t  b1, b1_pack;
	obj_t  c_pack;

	dim_t  i;
	dim_t  b_alg;
	dim_t  k_trans;

	// Initialize all pack objects that are passed into packm_init().
	bli_obj_init_pack( &a1_pack );
	bli_obj_init_pack( &b1_pack );
	bli_obj_init_pack( &c_pack );

	// Query dimension in partitioning direction.
	k_trans = bli_obj_width_after_trans( *a );

	// Scale C by beta (if instructed).
	bli_scalm_int( &BLIS_ONE,
	               c,
	               cntl_sub_scalm( cntl ) );

	// Initialize object for packing C.
	bli_packm_init( c, &c_pack,
	                cntl_sub_packm_c( cntl ) );

	// Pack C (if instructed).
	bli_packm_int( c, &c_pack,
	               cntl_sub_packm_c( cntl ) );

	// Partition along the k dimension.
	for ( i = 0; i < k_trans; i += b_alg )
	{
		// Determine the current algorithmic blocksize.
		// NOTE: Use of b (for execution datatype) is intentional!
		// This causes the right blocksize to be used if c and a are
		// complex and b is real.
		b_alg = bli_determine_blocksize_f( i, k_trans, b,
		                                   cntl_blocksize( cntl ) );

		// Acquire partitions for A1 and B1.
		bli_acquire_mpart_l2r( BLIS_SUBPART1,
		                       i, b_alg, a, &a1 );
		bli_acquire_mpart_t2b( BLIS_SUBPART1,
		                       i, b_alg, b, &b1 );

		// Initialize objects for packing A1 and B1.
		bli_packm_init( &a1, &a1_pack,
		                cntl_sub_packm_a( cntl ) );
		bli_packm_init( &b1, &b1_pack,
		                cntl_sub_packm_b( cntl ) );

		// Pack A1 (if instructed).
		bli_packm_int( &a1, &a1_pack,
		               cntl_sub_packm_a( cntl ) );

		// Pack B1 (if instructed).
		bli_packm_int( &b1, &b1_pack,
		               cntl_sub_packm_b( cntl ) );

		// Perform gemm subproblem.
		bli_gemm_int( &BLIS_ONE,
		              &a1_pack,
		              &b1_pack,
		              &BLIS_ONE,
		              &c_pack,
		              cntl_sub_gemm( cntl ) );

		// This variant executes multiple rank-k updates. Therefore, if the
		// internal beta scalar on matrix C is non-zero, we must use it
		// only for the first iteration (and then BLIS_ONE for all others).
		// And since c_pack is a local obj_t, we can simply overwrite the
		// internal beta scalar with BLIS_ONE once it has been used in the
		// first iteration.
		if ( i == 0 ) bli_obj_scalar_reset( &c_pack );
	}

	// Unpack C (if C was packed).
	bli_unpackm_int( &c_pack, c,
	                 cntl_sub_unpackm_c( cntl ) );

	// If any packing buffers were acquired within packm, release them back
	// to the memory manager.
	bli_obj_release_pack( &a1_pack );
	bli_obj_release_pack( &b1_pack );
	bli_obj_release_pack( &c_pack );
}
Пример #16
0
void bli_trsm_blk_var3
     (
       obj_t*  a,
       obj_t*  b,
       obj_t*  c,
       cntx_t* cntx,
       cntl_t* cntl,
       thrinfo_t* thread
     )
{
	obj_t a1, b1;

	dir_t direct;

	dim_t i;
	dim_t b_alg;
	dim_t k_trans;

	// Determine the direction in which to partition (forwards or backwards).
	direct = bli_l3_direct( a, b, c, cntl );

	// Prune any zero region that exists along the partitioning dimension.
	bli_l3_prune_unref_mparts_k( a, b, c, cntl );

	// Query dimension in partitioning direction.
	k_trans = bli_obj_width_after_trans( *a );

	// Partition along the k dimension.
	for ( i = 0; i < k_trans; i += b_alg )
	{
		// Determine the current algorithmic blocksize.
		b_alg = bli_trsm_determine_kc( direct, i, k_trans, a, b,
		                               bli_cntl_bszid( cntl ), cntx );

		// Acquire partitions for A1 and B1.
		bli_acquire_mpart_ndim( direct, BLIS_SUBPART1,
		                        i, b_alg, a, &a1 );
		bli_acquire_mpart_mdim( direct, BLIS_SUBPART1,
		                        i, b_alg, b, &b1 );

		// Perform trsm subproblem.
		bli_trsm_int
		(
		  &BLIS_ONE,
		  &a1,
		  &b1,
		  &BLIS_ONE,
		  c,
		  cntx,
		  bli_cntl_sub_node( cntl ),
		  bli_thrinfo_sub_node( thread )
		);

		//bli_thread_ibarrier( thread );
		bli_thread_obarrier( bli_thrinfo_sub_node( thread ) );

		// This variant executes multiple rank-k updates. Therefore, if the
		// internal alpha scalars on A/B and C are non-zero, we must ensure
		// that they are only used in the first iteration.
		if ( i == 0 )
		{
			bli_obj_scalar_reset( a ); bli_obj_scalar_reset( b );
			bli_obj_scalar_reset( c );
		}
	}
}
Пример #17
0
int main( int argc, char** argv )
{
	obj_t    a, b, c;
	obj_t    c_save;
	obj_t    alpha, beta;
	dim_t    m, n, k;
	dim_t    p;
	dim_t    p_begin, p_end, p_inc;
	int      m_input, n_input, k_input;
	num_t    dt, dt_real;
	char     dt_ch;
	int      r, n_repeats;
	trans_t  transa;
	trans_t  transb;
	f77_char f77_transa;
	f77_char f77_transb;

	double   dtime;
	double   dtime_save;
	double   gflops;

	extern blksz_t* gemm_kc;

	bli_init();

	//bli_error_checking_level_set( BLIS_NO_ERROR_CHECKING );

	n_repeats = 3;

	dt      = DT;
	dt_real = bli_datatype_proj_to_real( DT );

	p_begin = P_BEGIN;
	p_end   = P_END;
	p_inc   = P_INC;

	m_input = -1;
	n_input = -1;
	k_input = -1;

	// Extract the kc blocksize for the requested datatype and its
	// real analogue.
	dim_t kc      = bli_blksz_get_def( dt,      gemm_kc );
	dim_t kc_real = bli_blksz_get_def( dt_real, gemm_kc );

	// Assign the k dimension depending on which implementation is
	// being tested. Note that the BLIS_NAT case handles the real
	// domain cases as well as native complex.
	if      ( IND == BLIS_NAT  ) k_input = kc;
	else if ( IND == BLIS_3M1  ) k_input = kc_real / 3;
	else if ( IND == BLIS_4M1A ) k_input = kc_real / 2;
	else                         k_input = kc_real;

	// Adjust the relative dimensions, if requested.
#if   (defined ADJ_MK)
	m_input = -2; k_input = -2; n_input = -1;
#elif (defined ADJ_KN)
	k_input = -2; n_input = -2; m_input = -1;
#elif (defined ADJ_MN)
	m_input = -2; n_input = -2; k_input = -1;
#endif

	// Choose the char corresponding to the requested datatype.
	if      ( bli_is_float( dt ) )    dt_ch = 's';
	else if ( bli_is_double( dt ) )   dt_ch = 'd';
	else if ( bli_is_scomplex( dt ) ) dt_ch = 'c';
	else                              dt_ch = 'z';

	transa = BLIS_NO_TRANSPOSE;
	transb = BLIS_NO_TRANSPOSE;

	bli_param_map_blis_to_netlib_trans( transa, &f77_transa );
	bli_param_map_blis_to_netlib_trans( transb, &f77_transb );

	// 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_%s_%cgemm_%s_blis", THR_STR, dt_ch, STR );
#else
	printf( "data_%s_%cgemm_%s",      THR_STR, dt_ch, STR );
#endif
	printf( "( %2lu, 1:5 ) = [ %4lu %4lu %4lu  %10.3e  %6.3f ];\n",
	        ( unsigned long )(p - p_begin + 1)/p_inc + 1,
	        ( unsigned long )0,
	        ( unsigned long )0,
	        ( unsigned long )0, 0.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;
		if ( n_input < 0 ) n = p / ( dim_t )abs(n_input);
		else               n =     ( dim_t )    n_input;
		if ( k_input < 0 ) k = p / ( dim_t )abs(k_input);
		else               k =     ( dim_t )    k_input;

		bli_obj_create( dt, 1, 1, 0, 0, &alpha );
		bli_obj_create( dt, 1, 1, 0, 0, &beta );

		bli_obj_create( dt, m, k, 0, 0, &a );
		bli_obj_create( dt, k, n, 0, 0, &b );
		bli_obj_create( dt, m, n, 0, 0, &c );
		//bli_obj_create( dt, m, k, 2, 2*m, &a );
		//bli_obj_create( dt, k, n, 2, 2*k, &b );
		//bli_obj_create( dt, m, n, 2, 2*m, &c );
		bli_obj_create( dt, m, n, 0, 0, &c_save );

		bli_randm( &a );
		bli_randm( &b );
		bli_randm( &c );

		bli_obj_set_conjtrans( transa, a );
		bli_obj_set_conjtrans( transb, b );

		bli_setsc(  (2.0/1.0), 0.0, &alpha );
		bli_setsc( -(1.0/1.0), 0.0, &beta );


		bli_copym( &c, &c_save );
	
#ifdef BLIS
		bli_ind_disable_all_dt( dt );
		bli_ind_enable_dt( IND, dt );
#endif

		dtime_save = 1.0e9;

		for ( r = 0; r < n_repeats; ++r )
		{
			bli_copym( &c_save, &c );


			dtime = bli_clock();


#ifdef PRINT
			bli_printm( "a", &a, "%4.1f", "" );
			bli_printm( "b", &b, "%4.1f", "" );
			bli_printm( "c", &c, "%4.1f", "" );
#endif

#ifdef BLIS

			bli_gemm( &alpha,
			          &a,
			          &b,
			          &beta,
			          &c );

#else

		if ( bli_is_float( dt ) )
		{
			f77_int  mm     = bli_obj_length( c );
			f77_int  kk     = bli_obj_width_after_trans( a );
			f77_int  nn     = bli_obj_width( c );
			f77_int  lda    = bli_obj_col_stride( a );
			f77_int  ldb    = bli_obj_col_stride( b );
			f77_int  ldc    = bli_obj_col_stride( c );
			float*   alphap = bli_obj_buffer( alpha );
			float*   ap     = bli_obj_buffer( a );
			float*   bp     = bli_obj_buffer( b );
			float*   betap  = bli_obj_buffer( beta );
			float*   cp     = bli_obj_buffer( c );

			sgemm_( &f77_transa,
			        &f77_transb,
			        &mm,
			        &nn,
			        &kk,
			        alphap,
			        ap, &lda,
			        bp, &ldb,
			        betap,
			        cp, &ldc );
		}
		else if ( bli_is_double( dt ) )
		{
			f77_int  mm     = bli_obj_length( c );
			f77_int  kk     = bli_obj_width_after_trans( a );
			f77_int  nn     = bli_obj_width( c );
			f77_int  lda    = bli_obj_col_stride( a );
			f77_int  ldb    = bli_obj_col_stride( b );
			f77_int  ldc    = bli_obj_col_stride( c );
			double*  alphap = bli_obj_buffer( alpha );
			double*  ap     = bli_obj_buffer( a );
			double*  bp     = bli_obj_buffer( b );
			double*  betap  = bli_obj_buffer( beta );
			double*  cp     = bli_obj_buffer( c );

			dgemm_( &f77_transa,
			        &f77_transb,
			        &mm,
			        &nn,
			        &kk,
			        alphap,
			        ap, &lda,
			        bp, &ldb,
			        betap,
			        cp, &ldc );
		}
		else if ( bli_is_scomplex( dt ) )
		{
			f77_int  mm     = bli_obj_length( c );
			f77_int  kk     = bli_obj_width_after_trans( a );
			f77_int  nn     = bli_obj_width( c );
			f77_int  lda    = bli_obj_col_stride( a );
			f77_int  ldb    = bli_obj_col_stride( b );
			f77_int  ldc    = bli_obj_col_stride( c );
			scomplex*  alphap = bli_obj_buffer( alpha );
			scomplex*  ap     = bli_obj_buffer( a );
			scomplex*  bp     = bli_obj_buffer( b );
			scomplex*  betap  = bli_obj_buffer( beta );
			scomplex*  cp     = bli_obj_buffer( c );

			cgemm_( &f77_transa,
			        &f77_transb,
			        &mm,
			        &nn,
			        &kk,
			        alphap,
			        ap, &lda,
			        bp, &ldb,
			        betap,
			        cp, &ldc );
		}
		else if ( bli_is_dcomplex( dt ) )
		{
			f77_int  mm     = bli_obj_length( c );
			f77_int  kk     = bli_obj_width_after_trans( a );
			f77_int  nn     = bli_obj_width( c );
			f77_int  lda    = bli_obj_col_stride( a );
			f77_int  ldb    = bli_obj_col_stride( b );
			f77_int  ldc    = bli_obj_col_stride( c );
			dcomplex*  alphap = bli_obj_buffer( alpha );
			dcomplex*  ap     = bli_obj_buffer( a );
			dcomplex*  bp     = bli_obj_buffer( b );
			dcomplex*  betap  = bli_obj_buffer( beta );
			dcomplex*  cp     = bli_obj_buffer( c );

			zgemm_( &f77_transa,
			//zgemm3m_( &f77_transa,
			        &f77_transb,
			        &mm,
			        &nn,
			        &kk,
			        alphap,
			        ap, &lda,
			        bp, &ldb,
			        betap,
			        cp, &ldc );
		}
#endif

#ifdef PRINT
			bli_printm( "c after", &c, "%4.1f", "" );
			exit(1);
#endif


			dtime_save = bli_clock_min_diff( dtime_save, dtime );
		}

		gflops = ( 2.0 * m * k * n ) / ( dtime_save * 1.0e9 );

		if ( bli_is_complex( dt ) ) gflops *= 4.0;

#ifdef BLIS
		printf( "data_%s_%cgemm_%s_blis", THR_STR, dt_ch, STR );
#else
		printf( "data_%s_%cgemm_%s",      THR_STR, dt_ch, STR );
#endif
		printf( "( %2lu, 1:5 ) = [ %4lu %4lu %4lu  %10.3e  %6.3f ];\n",
		        ( unsigned long )(p - p_begin + 1)/p_inc + 1,
		        ( unsigned long )m,
		        ( unsigned long )k,
		        ( unsigned long )n, dtime_save, gflops );

		bli_obj_free( &alpha );
		bli_obj_free( &beta );

		bli_obj_free( &a );
		bli_obj_free( &b );
		bli_obj_free( &c );
		bli_obj_free( &c_save );
	}

	bli_finalize();

	return 0;
}
Пример #18
0
void bli_gemm_blk_var2( obj_t*  alpha,
                        obj_t*  a,
                        obj_t*  b,
                        obj_t*  beta,
                        obj_t*  c,
                        gemm_t* cntl )
{
	obj_t a_pack_s;
	obj_t b1_pack_s;
	obj_t c1_pack_s;

    obj_t  b1, c1;
    obj_t* a_pack   = NULL;
    obj_t* b1_pack  = NULL;
    obj_t* c1_pack  = NULL;

	dim_t i;
	dim_t b_alg;
	dim_t n_trans;
    
    dim_t num_groups = bli_gemm_num_thread_groups( cntl->thread_info );
    dim_t group_id   = bli_gemm_group_id( cntl->thread_info );

    if( bli_gemm_am_a_master( cntl->thread_info ) ) {
        // Initialize object for packing A.
        bli_obj_init_pack( &a_pack_s );
        bli_packm_init( a, &a_pack_s,
                        cntl_sub_packm_a( cntl ) );

    }
    a_pack = bli_gemm_broadcast_a( cntl->thread_info, &a_pack_s );

	// Pack A and scale by alpha (if instructed).
	bli_packm_int( alpha,
	               a, a_pack,
	               cntl_sub_packm_a( cntl ) );

    bli_gemm_a_barrier( cntl->thread_info );

	if( bli_gemm_am_b_master( cntl->thread_info )) {
        bli_obj_init_pack( &b1_pack_s );
    }
    b1_pack  = bli_gemm_broadcast_b( cntl->thread_info, &b1_pack_s );

    if( bli_gemm_am_c_master( cntl->thread_info )) {
        bli_obj_init_pack( &c1_pack_s );

        // Scale C by beta (if instructed).
        bli_scalm_int( beta,
                       c,
                       cntl_sub_scalm( cntl ) );
    }
    c1_pack  = bli_gemm_broadcast_c( cntl->thread_info, &c1_pack_s );


	// Query dimension in partitioning direction.
	n_trans = bli_obj_width_after_trans( *b );
    dim_t n_pt = n_trans / num_groups;
    n_pt = (n_pt * num_groups < n_trans) ? n_pt + 1 : n_pt;
    n_pt = (n_pt % 8 == 0) ? n_pt : n_pt + 8 - (n_pt % 8);
    dim_t start = group_id * n_pt;
    dim_t end = bli_min( start + n_pt, n_trans );

	// Partition along the n dimension.
	for ( i = start; i < end; i += b_alg )
	{
		// Determine the current algorithmic blocksize.
		// NOTE: Use of b (for execution datatype) is intentional!
		// This causes the right blocksize to be used if c and a are
		// complex and b is real.
		b_alg = bli_determine_blocksize_f( i, end, b,
		                                   cntl_blocksize( cntl ) );

        // Acquire partitions for C1 
        bli_acquire_mpart_l2r( BLIS_SUBPART1,
                               i, b_alg, c, &c1 );
        // Acquire partitions for B1 
        bli_acquire_mpart_l2r( BLIS_SUBPART1,
                               i, b_alg, b, &b1 );

        if( bli_gemm_am_b_master( cntl->thread_info )) {
            // Initialize objects for packing B1 
            bli_packm_init( &b1, &b1_pack_s,
                            cntl_sub_packm_b( cntl ) );
        }

        if( bli_gemm_am_c_master( cntl->thread_info )) {
            // Initialize objects for packing C1 
            bli_packm_init( &c1, &c1_pack_s,
                            cntl_sub_packm_c( cntl ) );
        }

        bli_gemm_b_barrier( cntl->thread_info );
        bli_gemm_c_barrier( cntl->thread_info );
        
		// Pack B1 and scale by alpha (if instructed).
		bli_packm_int( alpha,
		               &b1, b1_pack,
		               cntl_sub_packm_b( cntl ) );

		// Pack C1 and scale by beta (if instructed).
		bli_packm_int( beta,
		               &c1, c1_pack,
		               cntl_sub_packm_c( cntl ) );

        // Packing must be done before computation
        bli_gemm_b_barrier( cntl->thread_info );
        bli_gemm_c_barrier( cntl->thread_info );

		// Perform gemm subproblem.
		bli_gemm_int( alpha,
		              a_pack,
		              b1_pack,
		              beta,
		              c1_pack,
		              cntl_sub_gemm( cntl ) );

		// Unpack C1 (if C1 was packed).
		bli_unpackm_int( c1_pack, &c1,
		                 cntl_sub_unpackm_c( cntl ) );
	}

	// If any packing buffers were acquired within packm, release them back
	// to the memory manager.
    bli_gemm_a_barrier( cntl->thread_info );
    if( bli_gemm_am_a_master( cntl->thread_info ))
	    bli_obj_release_pack( &a_pack_s );
    bli_gemm_b_barrier( cntl->thread_info );
    if( bli_gemm_am_b_master( cntl->thread_info )) {
        bli_obj_release_pack( &b1_pack_s );
    }
    bli_gemm_c_barrier( cntl->thread_info );
    if( bli_gemm_am_c_master( cntl->thread_info )) {
        bli_obj_release_pack( &c1_pack_s );
    }
}
Пример #19
0
void bli_trmm_front( side_t  side,
                     obj_t*  alpha,
                     obj_t*  a,
                     obj_t*  b,
                     gemm_t* cntl )
{
	obj_t   a_local;
	obj_t   b_local;
	obj_t   c_local;

	// Check parameters.
	if ( bli_error_checking_is_enabled() )
		bli_trmm_check( side, alpha, a, b );

	// If alpha is zero, scale by beta and return.
	if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
	{
		bli_scalm( alpha, b );
		return;
	}

	// Alias A and B so we can tweak the objects if necessary.
	bli_obj_alias_to( *a, a_local );
	bli_obj_alias_to( *b, b_local );
	bli_obj_alias_to( *b, c_local );

	// We do not explicitly implement the cases where A is transposed.
	// However, we can still handle them. Specifically, if A is marked as
	// needing a transposition, we simply induce a transposition. This
	// allows us to only explicitly implement the no-transpose cases. Once
	// the transposition is induced, the correct algorithm will be called,
	// since, for example, an algorithm over a transposed lower triangular
	// matrix A moves in the same direction (forwards) as a non-transposed
	// upper triangular matrix. And with the transposition induced, the
	// matrix now appears to be upper triangular, so the upper triangular
	// algorithm will grab the correct partitions, as if it were upper
	// triangular (with no transpose) all along.
	if ( bli_obj_has_trans( a_local ) )
	{
		bli_obj_induce_trans( a_local );
		bli_obj_set_onlytrans( BLIS_NO_TRANSPOSE, a_local );
	}

#if 0

	// If A is being multiplied from the right, transpose all operands
	// so that we can perform the computation as if A were being multiplied
	// from the left.
	if ( bli_is_right( side ) )
	{
		bli_toggle_side( side );
		bli_obj_induce_trans( a_local );
		bli_obj_induce_trans( b_local );
		bli_obj_induce_trans( c_local );
	}

#else

	// An optimization: If C is stored by rows and the micro-kernel prefers
	// contiguous columns, or if C is stored by columns and the micro-kernel
	// prefers contiguous rows, transpose the entire operation to allow the
	// micro-kernel to access elements of C in its preferred manner.
	if (
	     ( bli_obj_is_row_stored( c_local ) &&
	       bli_func_prefers_contig_cols( bli_obj_datatype( c_local ),
	                                     bli_gemm_cntl_ukrs( cntl ) ) ) ||
	     ( bli_obj_is_col_stored( c_local ) &&
	       bli_func_prefers_contig_rows( bli_obj_datatype( c_local ),
	                                     bli_gemm_cntl_ukrs( cntl ) ) )
	   )
	{
		bli_toggle_side( side );
		bli_obj_induce_trans( a_local );
		bli_obj_induce_trans( b_local );
		bli_obj_induce_trans( c_local );
	}

	// If A is being multiplied from the right, swap A and B so that
	// the matrix will actually be on the right.
	if ( bli_is_right( side ) )
	{
		bli_obj_swap( a_local, b_local );
	}

#endif

	// Set each alias as the root object.
	// NOTE: We MUST wait until we are done potentially swapping the objects
	// before setting the root fields!
	bli_obj_set_as_root( a_local );
	bli_obj_set_as_root( b_local );
	bli_obj_set_as_root( c_local );
 

    trmm_thrinfo_t** infos = bli_create_trmm_thrinfo_paths( bli_is_right( side ) );
    dim_t n_threads = thread_num_threads( infos[0] );

    // Invoke the internal back-end.
    bli_level3_thread_decorator( n_threads,   
                                 (level3_int_t) bli_trmm_int, 
                                 alpha, 
                                 &a_local,  
                                 &b_local,  
                                 &BLIS_ZERO, 
                                 &c_local,  
                                 (void*) cntl, 
                                 (void**) infos );

    bli_trmm_thrinfo_free_paths( infos, n_threads );

#ifdef BLIS_ENABLE_FLOP_COUNT
	// Increment the global flop counter.
	bli_flop_count_inc( 1.0 * bli_obj_length( *c )
	                        * bli_obj_width( *c )
	                        * bli_obj_width_after_trans( a_local )
	                        * ( bli_obj_is_complex( *c ) ? 4.0 : 1.0 ) );
#endif
}
Пример #20
0
void bli_trmm_blk_var3b( obj_t*  a,
                         obj_t*  b,
                         obj_t*  c,
                         gemm_t* cntl,
                         trmm_thrinfo_t* thread )
{
    obj_t  c_pack_s;
    obj_t  a1_pack_s, b1_pack_s;

    obj_t  a1, b1;
    obj_t* a1_pack = NULL;
    obj_t* b1_pack = NULL;
    obj_t* c_pack = NULL;

	dim_t i;
	dim_t b_alg;
	dim_t k_trans;

    if( thread_am_ochief( thread ) ){
        // Initialize object for packing C
        bli_obj_init_pack( &c_pack_s );
        bli_packm_init( c, &c_pack_s,
                        cntl_sub_packm_c( cntl ) );

        // Scale C by beta (if instructed).
        bli_scalm_int( &BLIS_ONE,
                       c,  
                       cntl_sub_scalm( cntl ) );
    }   
    c_pack = thread_obroadcast( thread, &c_pack_s );

    // Initialize pack objects for A and B that are passed into packm_init().
    if( thread_am_ichief( thread ) ){
        bli_obj_init_pack( &a1_pack_s );
        bli_obj_init_pack( &b1_pack_s );
    }   
    a1_pack = thread_ibroadcast( thread, &a1_pack_s );
    b1_pack = thread_ibroadcast( thread, &b1_pack_s );

	// Pack C (if instructed).
	bli_packm_int( c, c_pack,
	               cntl_sub_packm_c( cntl ),
                   trmm_thread_sub_opackm( thread ) );

	// Query dimension in partitioning direction.
	k_trans = bli_obj_width_after_trans( *a );

	// Partition along the k dimension.
	for ( i = 0; i < k_trans; i += b_alg )
	{
		// Determine the current algorithmic blocksize.
		// NOTE: We call a trmm-specific function to determine the kc
		// blocksize so that we can implement the "nudging" of kc to be
		// a multiple of mr or nr, as needed.
		b_alg = bli_trmm_determine_kc_b( i, k_trans, a, b,
		                                 cntl_blocksize( cntl ) );

		// Acquire partitions for A1 and B1.
		bli_acquire_mpart_r2l( BLIS_SUBPART1,
		                       i, b_alg, a, &a1 );
		bli_acquire_mpart_b2t( BLIS_SUBPART1,
		                       i, b_alg, b, &b1 );

		// Initialize objects for packing A1 and B1.
        if( thread_am_ichief( thread ) ) {
            bli_packm_init( &a1, a1_pack,
                            cntl_sub_packm_a( cntl ) );
            bli_packm_init( &b1, b1_pack,
                            cntl_sub_packm_b( cntl ) );
        }
        thread_ibarrier( thread );

		// Pack A1 (if instructed).
		bli_packm_int( &a1, a1_pack,
		               cntl_sub_packm_a( cntl ),
                       trmm_thread_sub_ipackm( thread ) );

		// Pack B1 (if instructed).
		bli_packm_int( &b1, b1_pack,
		               cntl_sub_packm_b( cntl ),
                       trmm_thread_sub_ipackm( thread ) );

		// Perform trmm subproblem.
		bli_trmm_int( &BLIS_ONE,
		              a1_pack,
		              b1_pack,
		              &BLIS_ONE,
		              c_pack,
		              cntl_sub_gemm( cntl ),
                      trmm_thread_sub_trmm( thread ) );
        thread_ibarrier( thread );
	}

    thread_obarrier( thread );

    // Unpack C (if C was packed).
    bli_unpackm_int( c_pack, c,
                     cntl_sub_unpackm_c( cntl ),
                     trmm_thread_sub_opackm( thread ) );

    // If any packing buffers were acquired within packm, release them back
    // to the memory manager.
    if( thread_am_ochief( thread ) ){
        bli_packm_release( c_pack, cntl_sub_packm_c( cntl ) );
    }
    if( thread_am_ichief( thread ) ){
        bli_packm_release( a1_pack, cntl_sub_packm_a( cntl ) );
        bli_packm_release( b1_pack, cntl_sub_packm_b( cntl ) );
    }
}
Пример #21
0
void bli_trsm_blk_var3b( obj_t*  a,
                         obj_t*  b,
                         obj_t*  c,
                         trsm_t* cntl,
                         trsm_thrinfo_t* thread )
{
    obj_t  c_pack_s;
    obj_t  a1_pack_s, b1_pack_s;

    obj_t  a1, b1;
    obj_t* a1_pack = NULL;
    obj_t* b1_pack = NULL;
    obj_t* c_pack = NULL;

	dim_t  i;
	dim_t  b_alg;
	dim_t  k_trans;

	// Prune any zero region that exists along the partitioning dimension.
	bli_trsm_prune_unref_mparts_k( a, b, c );

	// Initialize pack objects for C that are passed into packm_init().
    if( thread_am_ochief( thread ) ) {
	    bli_obj_init_pack( &c_pack_s );

        // Initialize object for packing C.
        bli_packm_init( c, &c_pack_s,
                        cntl_sub_packm_c( cntl ) );

        // Scale C by beta (if instructed).
        bli_scalm_int( &BLIS_ONE,
                       c,
                       cntl_sub_scalm( cntl ) );
    }
    c_pack = thread_obroadcast( thread, &c_pack_s );

    if( thread_am_ichief( thread ) ) {
        bli_obj_init_pack( &a1_pack_s );
        bli_obj_init_pack( &b1_pack_s );
    }
    a1_pack = thread_ibroadcast( thread, &a1_pack_s );
    b1_pack = thread_ibroadcast( thread, &b1_pack_s );

	// Pack C (if instructed).
	bli_packm_int( c, c_pack,
	               cntl_sub_packm_c( cntl ),
                   trsm_thread_sub_opackm( thread ) );

	// Query dimension in partitioning direction.
	k_trans = bli_obj_width_after_trans( *a );

	// Partition along the k dimension.
	for ( i = 0; i < k_trans; i += b_alg )
	{
		// Determine the current algorithmic blocksize.
		// NOTE: We call a trsm-specific function to determine the kc
		// blocksize so that we can implement the "nudging" of kc to be
		// a multiple of mr, as needed.
		b_alg = bli_trsm_determine_kc_b( i, k_trans, b,
		                                 cntl_blocksize( cntl ) );

		// Acquire partitions for A1 and B1.
		bli_acquire_mpart_r2l( BLIS_SUBPART1,
		                       i, b_alg, a, &a1 );
		bli_acquire_mpart_b2t( BLIS_SUBPART1,
		                       i, b_alg, b, &b1 );

		// Initialize objects for packing A1 and B1.
        if( thread_am_ichief( thread ) ) {
            bli_packm_init( &a1, a1_pack,
                            cntl_sub_packm_a( cntl ) );
            bli_packm_init( &b1, b1_pack,
                            cntl_sub_packm_b( cntl ) );
        }
        thread_ibarrier( thread );

		// Pack A1 (if instructed).
		bli_packm_int( &a1, a1_pack,
		               cntl_sub_packm_a( cntl ),
                       trsm_thread_sub_ipackm( thread ) );

		// Pack B1 (if instructed).
		bli_packm_int( &b1, b1_pack,
		               cntl_sub_packm_b( cntl ),
                       trsm_thread_sub_ipackm( thread ) );

		// Perform trsm subproblem.
		bli_trsm_int( &BLIS_ONE,
		              a1_pack,
		              b1_pack,
		              &BLIS_ONE,
		              c_pack,
		              cntl_sub_trsm( cntl ),
                      trsm_thread_sub_trsm( thread ) );

		// This variant executes multiple rank-k updates. Therefore, if the
		// internal alpha scalars on A/B and C are non-zero, we must ensure
		// that they are only used in the first iteration.
        thread_ibarrier( thread );
		if ( i == 0 && thread_am_ichief( thread ) ) {
            bli_obj_scalar_reset( a );
            bli_obj_scalar_reset( b );
            bli_obj_scalar_reset( c_pack );
        }
	}

    thread_obarrier( thread );

	// Unpack C (if C was packed).
    bli_unpackm_int( c_pack, c,
                     cntl_sub_unpackm_c( cntl ),
                     trsm_thread_sub_opackm( thread ) );

	// If any packing buffers were acquired within packm, release them back
	// to the memory manager.
    if( thread_am_ochief( thread ) ) {
	    bli_packm_release( c_pack, cntl_sub_packm_c( cntl ) );
    }
    if( thread_am_ichief( thread ) ) {
        bli_packm_release( a1_pack, cntl_sub_packm_a( cntl ) );
        bli_packm_release( b1_pack, cntl_sub_packm_b( cntl ) );
    }
}
Пример #22
0
void bli_ger_blk_var2( obj_t* alpha,
                       obj_t* x,
                       obj_t* y,
                       obj_t* a,
                       cntx_t* cntx,
                       ger_t* cntl )
{
	obj_t a1, a1_pack;
	obj_t y1, y1_pack;

	dim_t i;
	dim_t b_alg;
	dim_t n_trans;

	// Initialize objects for packing.
	bli_obj_init_pack( &a1_pack );
	bli_obj_init_pack( &y1_pack );

	// Query dimension in partitioning direction.
	n_trans = bli_obj_width_after_trans( *a );

	// Partition along the n dimension.
	for ( i = 0; i < n_trans; i += b_alg )
	{
		// Determine the current algorithmic blocksize.
		b_alg = bli_determine_blocksize_f( i, n_trans, a,
		                                   bli_cntl_bszid( cntl ), cntx );

		// Acquire partitions for A1 and y1.
		bli_acquire_mpart_l2r( BLIS_SUBPART1,
		                       i, b_alg, a, &a1 );
		bli_acquire_vpart_f2b( BLIS_SUBPART1,
		                       i, b_alg, y, &y1 );

		// Initialize objects for packing A1 and y1 (if needed).
		bli_packm_init( &a1, &a1_pack,
		                cntx, bli_cntl_sub_packm_a( cntl ) );
		bli_packv_init( &y1, &y1_pack,
		                cntx, bli_cntl_sub_packv_y( cntl ) );

		// Copy/pack A1, y1 (if needed).
		bli_packm_int( &a1, &a1_pack,
		               cntx, bli_cntl_sub_packm_a( cntl ),
                       &BLIS_PACKM_SINGLE_THREADED );
		bli_packv_int( &y1, &y1_pack,
		               cntx, bli_cntl_sub_packv_y( cntl ) );

		// A1 = A1 + alpha * x * y1;
		bli_ger_int( BLIS_NO_CONJUGATE,
		             BLIS_NO_CONJUGATE,
		             alpha,
		             x,
		             &y1_pack,
		             &a1_pack,
		             cntx,
		             bli_cntl_sub_ger( cntl ) );

		// Copy/unpack A1 (if A1 was packed).
		bli_unpackm_int( &a1_pack, &a1,
		                 cntx, bli_cntl_sub_unpackm_a( cntl ),
                         &BLIS_PACKM_SINGLE_THREADED );
	}

	// If any packing buffers were acquired within packm, release them back
	// to the memory manager.
	bli_packm_release( &a1_pack, bli_cntl_sub_packm_a( cntl ) );
	bli_packv_release( &y1_pack, bli_cntl_sub_packv_y( cntl ) );
}
Пример #23
0
void bli_trmm_blk_var2f( obj_t*  a,
                         obj_t*  b,
                         obj_t*  c,
                         trmm_t* cntl )
{
    obj_t a_pack;
    obj_t b1, b1_pack;
    obj_t c1, c1_pack;

    dim_t i;
    dim_t b_alg;
    dim_t n_trans;

    // Initialize all pack objects that are passed into packm_init().
    bli_obj_init_pack( &a_pack );
    bli_obj_init_pack( &b1_pack );
    bli_obj_init_pack( &c1_pack );

    // Query dimension in partitioning direction.
    n_trans = bli_obj_width_after_trans( *b );

    // Scale C by beta (if instructed).
    bli_scalm_int( &BLIS_ONE,
                   c,
                   cntl_sub_scalm( cntl ) );

    // Initialize object for packing A.
    bli_packm_init( a, &a_pack,
                    cntl_sub_packm_a( cntl ) );

    // Pack A (if instructed).
    bli_packm_int( a, &a_pack,
                   cntl_sub_packm_a( cntl ) );

    // Partition along the n dimension.
    for ( i = 0; i < n_trans; i += b_alg )
    {
        // Determine the current algorithmic blocksize.
        b_alg = bli_determine_blocksize_f( i, n_trans, b,
                                           cntl_blocksize( cntl ) );

        // Acquire partitions for B1 and C1.
        bli_acquire_mpart_l2r( BLIS_SUBPART1,
                               i, b_alg, b, &b1 );
        bli_acquire_mpart_l2r( BLIS_SUBPART1,
                               i, b_alg, c, &c1 );

        // Initialize objects for packing A1 and B1.
        bli_packm_init( &b1, &b1_pack,
                        cntl_sub_packm_b( cntl ) );
        bli_packm_init( &c1, &c1_pack,
                        cntl_sub_packm_c( cntl ) );

        // Pack B1 (if instructed).
        bli_packm_int( &b1, &b1_pack,
                       cntl_sub_packm_b( cntl ) );

        // Pack C1 (if instructed).
        bli_packm_int( &c1, &c1_pack,
                       cntl_sub_packm_c( cntl ) );

        // Perform trmm subproblem.
        bli_trmm_int( &BLIS_ONE,
                      &a_pack,
                      &b1_pack,
                      &BLIS_ONE,
                      &c1_pack,
                      cntl_sub_trmm( cntl ) );

        // Unpack C1 (if C1 was packed).
        bli_unpackm_int( &c1_pack, &c1,
                         cntl_sub_unpackm_c( cntl ) );
    }

    // If any packing buffers were acquired within packm, release them back
    // to the memory manager.
    bli_obj_release_pack( &a_pack );
    bli_obj_release_pack( &b1_pack );
    bli_obj_release_pack( &c1_pack );
}
Пример #24
0
int main( int argc, char** argv )
{
	obj_t a, c;
	obj_t c_save;
	obj_t alpha, beta;
	dim_t m, k;
	dim_t p;
	dim_t p_begin, p_end, p_inc;
	int   m_input, k_input;
	num_t dt_a, dt_c;
	num_t dt_alpha, dt_beta;
	int   r, n_repeats;
	uplo_t uplo;

	double dtime;
	double dtime_save;
	double gflops;

	bli_init();

	n_repeats = 3;

    if( argc < 7 ) 
    {   
        printf("Usage:\n");
        printf("test_foo.x m n k p_begin p_inc p_end:\n");
        exit;
    }   

    int world_size, world_rank, provided;
    MPI_Init_thread( NULL, NULL, MPI_THREAD_FUNNELED, &provided );
    MPI_Comm_size( MPI_COMM_WORLD, &world_size );
    MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );

    m_input = strtol( argv[1], NULL, 10 );
    k_input = strtol( argv[3], NULL, 10 );
    p_begin = strtol( argv[4], NULL, 10 );
    p_inc   = strtol( argv[5], NULL, 10 );
    p_end   = strtol( argv[6], NULL, 10 );

	dt_a = BLIS_DOUBLE;
	dt_c = BLIS_DOUBLE;
	dt_alpha = BLIS_DOUBLE;
	dt_beta = BLIS_DOUBLE;

	uplo = BLIS_LOWER;

    for ( p = p_begin + world_rank * p_inc; p <= p_end; p += p_inc * world_size )
	{

		if ( m_input < 0 ) m = p * ( dim_t )abs(m_input);
		else               m =     ( dim_t )    m_input;
		if ( k_input < 0 ) k = p * ( dim_t )abs(k_input);
		else               k =     ( dim_t )    k_input;


		bli_obj_create( dt_alpha, 1, 1, 0, 0, &alpha );
		bli_obj_create( dt_beta,  1, 1, 0, 0, &beta );

		bli_obj_create( dt_a, m, k, 0, 0, &a );
		bli_obj_create( dt_c, m, m, 0, 0, &c );
		bli_obj_create( dt_c, m, m, 0, 0, &c_save );

		bli_randm( &a );
		bli_randm( &c );

		bli_obj_set_struc( BLIS_HERMITIAN, &c );
		bli_obj_set_uplo( uplo, &c );


		bli_setsc(  (2.0/1.0), 0.0, &alpha );
		bli_setsc(  (1.0/1.0), 0.0, &beta );


		bli_copym( &c, &c_save );
	
		dtime_save = 1.0e9;

		for ( r = 0; r < n_repeats; ++r )
		{
			bli_copym( &c_save, &c );


			dtime = bli_clock();

#ifdef PRINT
			bli_printm( "a", &a, "%4.1f", "" );
			bli_printm( "c", &c, "%4.1f", "" );
#endif

#ifdef BLIS

			//bli_error_checking_level_set( BLIS_NO_ERROR_CHECKING );

			bli_herk( &alpha,
			          &a,
			          &beta,
			          &c );

#else

			f77_char uploa  = 'L';
			f77_char transa = 'N';
			f77_int  mm     = bli_obj_length( &c );
			f77_int  kk     = bli_obj_width_after_trans( &a );
			f77_int  lda    = bli_obj_col_stride( &a );
			f77_int  ldc    = bli_obj_col_stride( &c );
			double*  alphap = bli_obj_buffer( &alpha );
			double*  ap     = bli_obj_buffer( &a );
			double*  betap  = bli_obj_buffer( &beta );
			double*  cp     = bli_obj_buffer( &c );

			dsyrk_( &uploa,
			        &transa,
			        &mm,
			        &kk,
			        alphap,
			        ap, &lda,
			        betap,
			        cp, &ldc );
#endif

#ifdef PRINT
			bli_printm( "c after", &c, "%4.1f", "" );
			exit(1);
#endif


			dtime_save = bli_clock_min_diff( dtime_save, dtime );
		}

		gflops = ( 1.0 * m * k * m ) / ( dtime_save * 1.0e9 );

#ifdef BLIS
		printf( "data_herk_blis" );
#else
		printf( "data_herk_%s", BLAS );
#endif
		printf( "( %2lu, 1:4 ) = [ %4lu %4lu  %10.3e  %6.3f ];\n",
		        ( unsigned long )(p - p_begin + 1)/p_inc + 1,
		        ( unsigned long )m,
		        ( unsigned long )k, dtime_save, gflops );


		bli_obj_free( &alpha );
		bli_obj_free( &beta );

		bli_obj_free( &a );
		bli_obj_free( &c );
		bli_obj_free( &c_save );
	}

	bli_finalize();

	return 0;
}
Пример #25
0
void bli_gemv_blk_var2( obj_t*  alpha,
                        obj_t*  a,
                        obj_t*  x,
                        obj_t*  beta,
                        obj_t*  y,
                        cntx_t* cntx,
                        gemv_t* cntl )
{
	obj_t a1, a1_pack;
	obj_t x1, x1_pack;

	dim_t n_trans;
	dim_t i;
	dim_t b_alg;

	// Initialize objects for packing.
	bli_obj_init_pack( &a1_pack );
	bli_obj_init_pack( &x1_pack );

	// Query dimension in partitioning direction.
	n_trans = bli_obj_width_after_trans( a );

	// y = beta * y;
	bli_scalv_int( beta,
	               y,
	               cntx, bli_cntl_sub_scalv( cntl ) );

	// Partition along the "k" dimension (n dimension of A).
	for ( i = 0; i < n_trans; i += b_alg )
	{
		// Determine the current algorithmic blocksize.
		b_alg = bli_determine_blocksize_f( i, n_trans, a,
		                                   bli_cntl_bszid( cntl ), cntx );

		// Acquire partitions for A1 and x1.
		bli_acquire_mpart_l2r( BLIS_SUBPART1,
		                       i, b_alg, a, &a1 );
		bli_acquire_vpart_f2b( BLIS_SUBPART1,
		                       i, b_alg, x, &x1 );

		// Initialize objects for packing A1 and x1 (if needed).
		bli_packm_init( &a1, &a1_pack,
		                cntx, bli_cntl_sub_packm_a( cntl ) );
		bli_packv_init( &x1, &x1_pack,
		                cntx, bli_cntl_sub_packv_x( cntl ) );

		// Copy/pack A1, x1 (if needed).
		bli_packm_int( &a1, &a1_pack,
		               cntx, bli_cntl_sub_packm_a( cntl ),
                       &BLIS_PACKM_SINGLE_THREADED );
		bli_packv_int( &x1, &x1_pack,
		               cntx, bli_cntl_sub_packv_x( cntl ) );

		// y = y + alpha * A1 * x1;
		bli_gemv_int( BLIS_NO_TRANSPOSE,
		              BLIS_NO_CONJUGATE,
		              alpha,
		              &a1_pack,
		              &x1_pack,
		              &BLIS_ONE,
		              y,
		              cntx,
		              bli_cntl_sub_gemv( cntl ) );
	}

	// If any packing buffers were acquired within packm, release them back
	// to the memory manager.
	bli_packm_release( &a1_pack, bli_cntl_sub_packm_a( cntl ) );
	bli_packv_release( &x1_pack, bli_cntl_sub_packv_x( cntl ) );
}
Пример #26
0
void bli_trmm_lu_blk_var1( obj_t*  alpha,
                           obj_t*  a,
                           obj_t*  b,
                           obj_t*  beta,
                           obj_t*  c,
                           trmm_t* cntl )
{
	obj_t a1, a1_pack;
	obj_t b_pack;
	obj_t c1, c1_pack;

	dim_t i;
	dim_t b_alg;
	dim_t mT_trans;

	// Initialize all pack objects that are passed into packm_init().
	bli_obj_init_pack( &a1_pack );
	bli_obj_init_pack( &b_pack );
	bli_obj_init_pack( &c1_pack );

	// If A is [upper] triangular, use the diagonal offset of A to determine
	// the length of the non-zero region.
	if ( bli_obj_is_triangular( *a ) )
		mT_trans = bli_abs( bli_obj_diag_offset_after_trans( *a ) ) +
		           bli_obj_width_after_trans( *a );
	else // if ( bli_obj_is_general( *a )
		mT_trans = bli_obj_length_after_trans( *a );

	// Scale C by beta (if instructed).
	bli_scalm_int( beta,
	               c,
	               cntl_sub_scalm( cntl ) );

	// Initialize object for packing B.
	bli_packm_init( b, &b_pack,
	                cntl_sub_packm_b( cntl ) );

	// Pack B and scale by alpha (if instructed).
	bli_packm_int( alpha,
	               b, &b_pack,
	               cntl_sub_packm_b( cntl ) );

	// Partition along the m dimension.
	for ( i = 0; i < mT_trans; i += b_alg )
	{
		// Determine the current algorithmic blocksize.
		b_alg = bli_determine_blocksize_f( i, mT_trans, a,
		                                   cntl_blocksize( cntl ) );

		// Acquire partitions for A1 and C1.
		bli_acquire_mpart_t2b( BLIS_SUBPART1,
		                       i, b_alg, a, &a1 );
		bli_acquire_mpart_t2b( BLIS_SUBPART1,
		                       i, b_alg, c, &c1 );

		// Initialize objects for packing A1 and C1.
		bli_packm_init( &a1, &a1_pack,
		                cntl_sub_packm_a( cntl ) );
		bli_packm_init( &c1, &c1_pack,
		                cntl_sub_packm_c( cntl ) );

		// Pack A1 and scale by alpha (if instructed).
		bli_packm_int( alpha,
		               &a1, &a1_pack,
		               cntl_sub_packm_a( cntl ) );

		// Pack C1 and scale by beta (if instructed).
		bli_packm_int( beta,
		               &c1, &c1_pack,
		               cntl_sub_packm_c( cntl ) );

		// Perform trmm subproblem.
		bli_trmm_int( BLIS_LEFT,
		              alpha,
		              &a1_pack,
		              &b_pack,
		              beta,
		              &c1_pack,
		              cntl_sub_trmm( cntl ) );

		// Unpack C1 (if C1 was packed).
		bli_unpackm_int( &c1_pack, &c1,
		                 cntl_sub_unpackm_c( cntl ) );
	}

	// If any packing buffers were acquired within packm, release them back
	// to the memory manager.
	bli_obj_release_pack( &a1_pack );
	bli_obj_release_pack( &b_pack );
	bli_obj_release_pack( &c1_pack );
}
Пример #27
0
int main( int argc, char** argv )
{
	obj_t a, c;
	obj_t c_save;
	obj_t alpha, beta;
	dim_t m, k;
	dim_t p;
	dim_t p_begin, p_end, p_inc;
	int   m_input, k_input;
	num_t dt;
	int   r, n_repeats;
	uplo_t uploc;
	trans_t transa;
	f77_char f77_uploc;
	f77_char f77_transa;

	double dtime;
	double dtime_save;
	double gflops;

	bli_init();

	//bli_error_checking_level_set( BLIS_NO_ERROR_CHECKING );

	n_repeats = 3;

#ifndef PRINT
	p_begin = 200;
	p_end   = 2000;
	p_inc   = 200;

	m_input = -1;
	k_input = -1;
#else
	p_begin = 16;
	p_end   = 16;
	p_inc   = 1;

	m_input = 3;
	k_input = 1;
#endif

#if 1
	//dt = BLIS_FLOAT;
	dt = BLIS_DOUBLE;
#else
	//dt = BLIS_SCOMPLEX;
	dt = BLIS_DCOMPLEX;
#endif

	uploc = BLIS_LOWER;
	//uploc = BLIS_UPPER;

	transa = BLIS_NO_TRANSPOSE;

	bli_param_map_blis_to_netlib_uplo( uploc, &f77_uploc );
	bli_param_map_blis_to_netlib_trans( transa, &f77_transa );


	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;
		if ( k_input < 0 ) k = p * ( dim_t )abs(k_input);
		else               k =     ( dim_t )    k_input;

		bli_obj_create( dt, 1, 1, 0, 0, &alpha );
		bli_obj_create( dt, 1, 1, 0, 0, &beta );

		if ( bli_does_trans( transa ) )
			bli_obj_create( dt, k, m, 0, 0, &a );
		else
			bli_obj_create( dt, m, k, 0, 0, &a );
		bli_obj_create( dt, m, m, 0, 0, &c );
		bli_obj_create( dt, m, m, 0, 0, &c_save );

		bli_randm( &a );
		bli_randm( &c );

		bli_obj_set_struc( BLIS_HERMITIAN, c );
		bli_obj_set_uplo( uploc, c );

		bli_obj_set_conjtrans( transa, a );


		bli_setsc(  (2.0/1.0), 0.0, &alpha );
		bli_setsc( -(1.0/1.0), 0.0, &beta );


		bli_copym( &c, &c_save );
	
		dtime_save = 1.0e9;

		for ( r = 0; r < n_repeats; ++r )
		{
			bli_copym( &c_save, &c );


			dtime = bli_clock();


#ifdef PRINT
			bli_printm( "a", &a, "%4.1f", "" );
			bli_printm( "c", &c, "%4.1f", "" );
#endif

#ifdef BLIS

			bli_herk( &alpha,
			          &a,
			          &beta,
			          &c );

#else
		if ( bli_is_float( dt ) )
		{
			f77_int  mm     = bli_obj_length( c );
			f77_int  kk     = bli_obj_width_after_trans( a );
			f77_int  lda    = bli_obj_col_stride( a );
			f77_int  ldc    = bli_obj_col_stride( c );
			float*   alphap = bli_obj_buffer( alpha );
			float*   ap     = bli_obj_buffer( a );
			float*   betap  = bli_obj_buffer( beta );
			float*   cp     = bli_obj_buffer( c );

			ssyrk_( &f77_uploc,
			        &f77_transa,
			        &mm,
			        &kk,
			        alphap,
			        ap, &lda,
			        betap,
			        cp, &ldc );
		}
		else if ( bli_is_double( dt ) )
		{
			f77_int  mm     = bli_obj_length( c );
			f77_int  kk     = bli_obj_width_after_trans( a );
			f77_int  lda    = bli_obj_col_stride( a );
			f77_int  ldc    = bli_obj_col_stride( c );
			double*  alphap = bli_obj_buffer( alpha );
			double*  ap     = bli_obj_buffer( a );
			double*  betap  = bli_obj_buffer( beta );
			double*  cp     = bli_obj_buffer( c );

			dsyrk_( &f77_uploc,
			        &f77_transa,
			        &mm,
			        &kk,
			        alphap,
			        ap, &lda,
			        betap,
			        cp, &ldc );
		}
		else if ( bli_is_scomplex( dt ) )
		{
			f77_int  mm     = bli_obj_length( c );
			f77_int  kk     = bli_obj_width_after_trans( a );
			f77_int  lda    = bli_obj_col_stride( a );
			f77_int  ldc    = bli_obj_col_stride( c );
			float*     alphap = bli_obj_buffer( alpha );
			scomplex*  ap     = bli_obj_buffer( a );
			float*     betap  = bli_obj_buffer( beta );
			scomplex*  cp     = bli_obj_buffer( c );

			cherk_( &f77_uploc,
			        &f77_transa,
			        &mm,
			        &kk,
			        alphap,
			        ap, &lda,
			        betap,
			        cp, &ldc );
		}
		else if ( bli_is_dcomplex( dt ) )
		{
			f77_int  mm     = bli_obj_length( c );
			f77_int  kk     = bli_obj_width_after_trans( a );
			f77_int  lda    = bli_obj_col_stride( a );
			f77_int  ldc    = bli_obj_col_stride( c );
			double*    alphap = bli_obj_buffer( alpha );
			dcomplex*  ap     = bli_obj_buffer( a );
			double*    betap  = bli_obj_buffer( beta );
			dcomplex*  cp     = bli_obj_buffer( c );

			zherk_( &f77_uploc,
			        &f77_transa,
			        &mm,
			        &kk,
			        alphap,
			        ap, &lda,
			        betap,
			        cp, &ldc );
		}
#endif

#ifdef PRINT
			bli_printm( "c after", &c, "%4.1f", "" );
			exit(1);
#endif


			dtime_save = bli_clock_min_diff( dtime_save, dtime );
		}

		gflops = ( 1.0 * m * k * m ) / ( dtime_save * 1.0e9 );

		if ( bli_is_complex( dt ) ) gflops *= 4.0;

#ifdef BLIS
		printf( "data_herk_blis" );
#else
		printf( "data_herk_%s", BLAS );
#endif
		printf( "( %2lu, 1:4 ) = [ %4lu %4lu  %10.3e  %6.3f ];\n",
		        ( unsigned long )(p - p_begin + 1)/p_inc + 1,
		        ( unsigned long )m,
		        ( unsigned long )k, dtime_save, gflops );


		bli_obj_free( &alpha );
		bli_obj_free( &beta );

		bli_obj_free( &a );
		bli_obj_free( &c );
		bli_obj_free( &c_save );
	}

	bli_finalize();

	return 0;
}
Пример #28
0
void libblis_test_gemm_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  n       = bli_obj_width( *c );
	dim_t  k       = bli_obj_width_after_trans( *a );

	obj_t  kappa, 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,      &kappa );
	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 );

	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 );

	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 );
}
Пример #29
0
void bli_herk_blk_var3f( obj_t*  a,
                         obj_t*  ah,
                         obj_t*  c,
                         herk_t* cntl,
                         herk_thrinfo_t* thread )
{
    obj_t  c_pack_s;
    obj_t  a1_pack_s, ah1_pack_s;

	obj_t  a1, ah1;
    obj_t* a1_pack = NULL;
    obj_t* ah1_pack = NULL;
	obj_t* c_pack = NULL;

	dim_t  i;
	dim_t  b_alg;
	dim_t  k_trans;

    if( thread_am_ochief( thread ) ) {
        // Initialize object for packing C.
	    bli_obj_init_pack( &c_pack_s );
        bli_packm_init( c, &c_pack_s,
                        cntl_sub_packm_c( cntl ) );
        
        // Scale C by beta (if instructed).
        bli_scalm_int( &BLIS_ONE,
                       c,
                       cntl_sub_scalm( cntl ) );
    }
    c_pack = thread_obroadcast( thread, &c_pack_s );

	// Initialize all pack objects that are passed into packm_init().
    if( thread_am_ichief( thread ) ) {
        bli_obj_init_pack( &a1_pack_s );
        bli_obj_init_pack( &ah1_pack_s );
    }
    a1_pack = thread_ibroadcast( thread, &a1_pack_s );
    ah1_pack = thread_ibroadcast( thread, &ah1_pack_s );

	// Pack C (if instructed).
	bli_packm_int( c, c_pack,
	               cntl_sub_packm_c( cntl ),
                   herk_thread_sub_opackm( thread ) );

	// Query dimension in partitioning direction.
	k_trans = bli_obj_width_after_trans( *a );

	// Partition along the k dimension.
	for ( i = 0; i < k_trans; i += b_alg )
	{
		// Determine the current algorithmic blocksize.
		b_alg = bli_determine_blocksize_f( i, k_trans, a,
		                                   cntl_blocksize( cntl ) );

		// Acquire partitions for A1 and A1'.
		bli_acquire_mpart_l2r( BLIS_SUBPART1,
		                       i, b_alg, a, &a1 );
		bli_acquire_mpart_t2b( BLIS_SUBPART1,
		                       i, b_alg, ah, &ah1 );

		// Initialize objects for packing A1 and A1'.
        if( thread_am_ichief( thread ) ) {
            bli_packm_init( &a1, a1_pack,
                            cntl_sub_packm_a( cntl ) );
            bli_packm_init( &ah1, ah1_pack,
                            cntl_sub_packm_b( cntl ) );
        }
        thread_ibarrier( thread );

		// Pack A1 (if instructed).
		bli_packm_int( &a1, a1_pack,
		               cntl_sub_packm_a( cntl ),
                       herk_thread_sub_ipackm( thread ) );

		// Pack B1 (if instructed).
		bli_packm_int( &ah1, ah1_pack,
		               cntl_sub_packm_b( cntl ),
                       herk_thread_sub_ipackm( thread ) );

		// Perform herk subproblem.
		bli_herk_int( &BLIS_ONE,
		              a1_pack,
		              ah1_pack,
		              &BLIS_ONE,
		              c_pack,
		              cntl_sub_herk( cntl ),
                      herk_thread_sub_herk( thread ) );

        // This variant executes multiple rank-k updates. Therefore, if the
        // internal beta scalar on matrix C is non-zero, we must use it
        // only for the first iteration (and then BLIS_ONE for all others).
        // And since c_pack is a local obj_t, we can simply overwrite the
        // internal beta scalar with BLIS_ONE once it has been used in the
        // first iteration.
        if ( i == 0 ) thread_ibarrier( thread );
        if ( i == 0 && thread_am_ichief( thread ) ) bli_obj_scalar_reset( c_pack );

	}

    thread_obarrier( thread );
    
	// Unpack C (if C was packed).
    bli_unpackm_int( c_pack, c,
                     cntl_sub_unpackm_c( cntl ),
                     herk_thread_sub_opackm( thread ) );

	// If any packing buffers were acquired within packm, release them back
	// to the memory manager.
    if( thread_am_ochief( thread ) ) {
	    bli_obj_release_pack( c_pack );
    }
    if( thread_am_ichief( thread ) ) {
        bli_obj_release_pack( a1_pack );
        bli_obj_release_pack( ah1_pack );
    }
}
Пример #30
0
void bli_trsm_blk_var2b( obj_t*  a,
                         obj_t*  b,
                         obj_t*  c,
                         trsm_t* cntl,
                         trsm_thrinfo_t* thread )
{
    obj_t a_pack_s;
    obj_t b1_pack_s, c1_pack_s;

    obj_t b1, c1;
	obj_t* a_pack = NULL;
	obj_t* b1_pack = NULL;
	obj_t* c1_pack = NULL;

	dim_t i;
	dim_t b_alg;
	dim_t n_trans;

	// Initialize pack objects for A that are passed into packm_init().
    if( thread_am_ochief( thread ) ) {
	    bli_obj_init_pack( &a_pack_s );

        // Initialize object for packing A.
        bli_packm_init( a, &a_pack_s,
                        cntl_sub_packm_a( cntl ) );

        // Scale C by beta (if instructed).
        bli_scalm_int( &BLIS_ONE,
                       c,
                       cntl_sub_scalm( cntl ) );
    }
    a_pack = thread_obroadcast( thread, &a_pack_s );

	// Initialize pack objects for B and C that are passed into packm_init().
    if( thread_am_ichief( thread ) ) {
        bli_obj_init_pack( &b1_pack_s );
        bli_obj_init_pack( &c1_pack_s );
    }
    b1_pack = thread_ibroadcast( thread, &b1_pack_s );
    c1_pack = thread_ibroadcast( thread, &c1_pack_s );

	// Pack A (if instructed).
	bli_packm_int( a, a_pack,
	               cntl_sub_packm_a( cntl ),
                   trmm_thread_sub_opackm( thread ) );

	// Query dimension in partitioning direction.
	n_trans = bli_obj_width_after_trans( *b );
    dim_t start, end;
    num_t dt = bli_obj_execution_datatype( *a );
    bli_get_range_r2l( thread, 0, n_trans,
                       //bli_lcm( bli_info_get_default_nr( BLIS_TRSM, dt ),
	                   //         bli_info_get_default_mr( BLIS_TRSM, dt ) ),
	                   bli_lcm( bli_blksz_get_nr( dt, cntl_blocksize( cntl ) ),
	                            bli_blksz_get_mr( dt, cntl_blocksize( cntl ) ) ),
                       &start, &end );

	// Partition along the n dimension.
	for ( i = start; i < end; i += b_alg )
	{
		// Determine the current algorithmic blocksize.
		b_alg = bli_determine_blocksize_b( i, end, b,
		                                   cntl_blocksize( cntl ) );

		// Acquire partitions for B1 and C1.
		bli_acquire_mpart_r2l( BLIS_SUBPART1,
		                       i, b_alg, b, &b1 );
		bli_acquire_mpart_r2l( BLIS_SUBPART1,
		                       i, b_alg, c, &c1 );

		// Initialize objects for packing A1 and B1.
        if( thread_am_ichief( thread ) ) {
            bli_packm_init( &b1, b1_pack,
                            cntl_sub_packm_b( cntl ) );
            bli_packm_init( &c1, c1_pack,
                            cntl_sub_packm_c( cntl ) );
        }
        thread_ibarrier( thread );

		// Pack B1 (if instructed).
		bli_packm_int( &b1, b1_pack,
		               cntl_sub_packm_b( cntl ),
                       trsm_thread_sub_ipackm( thread ) );

		// Pack C1 (if instructed).
		bli_packm_int( &c1, c1_pack,
		               cntl_sub_packm_c( cntl ),
                       trsm_thread_sub_ipackm( thread ) );

		// Perform trsm subproblem.
		bli_trsm_int( &BLIS_ONE,
		              a_pack,
		              b1_pack,
		              &BLIS_ONE,
		              c1_pack,
		              cntl_sub_trsm( cntl ),
                      trsm_thread_sub_trsm( thread ) );
        thread_ibarrier( thread );

		// Unpack C1 (if C1 was packed).
        bli_unpackm_int( c1_pack, &c1,
                         cntl_sub_unpackm_c( cntl ),
                         trsm_thread_sub_ipackm( thread ) );
	}

	// If any packing buffers were acquired within packm, release them back
	// to the memory manager.
    thread_obarrier( thread );
    if( thread_am_ochief( thread ) )
    	bli_packm_release( a_pack, cntl_sub_packm_a( cntl ) );
    if( thread_am_ichief( thread ) ) {
        bli_packm_release( b1_pack, cntl_sub_packm_b( cntl ) );
        bli_packm_release( c1_pack, cntl_sub_packm_c( cntl ) );
    }
}