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; }
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 ); }
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; }
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 ); } }
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 ); }
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 ); }
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 ); }
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; }
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; }
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 ); }
void libblis_test_her2k_check ( test_params_t* params, obj_t* alpha, obj_t* a, obj_t* b, obj_t* beta, obj_t* c, obj_t* c_orig, double* resid ) { num_t dt = bli_obj_datatype( *c ); num_t dt_real = bli_obj_datatype_proj_to_real( *c ); dim_t m = bli_obj_length( *c ); dim_t k = bli_obj_width_after_trans( *a ); obj_t alphac, ah, bh; obj_t norm; obj_t t, v, w1, w2, z; double junk; // // Pre-conditions: // - a is randomized. // - b is randomized. // - c_orig is randomized and Hermitian. // Note: // - alpha should have a non-zero imaginary component in the // complex cases in order to more fully exercise the implementation. // - beta must be real-valued. // // Under these conditions, we assume that the implementation for // // C := beta * C_orig + alpha * transa(A) * transb(B)^H + conj(alpha) * transb(B) * transa(A)^H // // is functioning correctly if // // normf( v - z ) // // is negligible, where // // v = C * t // z = ( beta * C_orig + alpha * transa(A) * transb(B)^H + conj(alpha) * transb(B) * transa(A)^H ) * t // = beta * C_orig * t + alpha * transa(A) * transb(B)^H * t + conj(alpha) * transb(B) * transa(A)^H * t // = beta * C_orig * t + alpha * transa(A) * transb(B)^H * t + conj(alpha) * transb(B) * w2 // = beta * C_orig * t + alpha * transa(A) * w1 + conj(alpha) * transb(B) * w2 // = beta * C_orig * t + alpha * transa(A) * w1 + z // = beta * C_orig * t + z // bli_obj_alias_with_trans( BLIS_CONJ_TRANSPOSE, *a, ah ); bli_obj_alias_with_trans( BLIS_CONJ_TRANSPOSE, *b, bh ); bli_obj_scalar_init_detached( dt_real, &norm ); bli_obj_scalar_init_detached_copy_of( dt, BLIS_CONJUGATE, alpha, &alphac ); bli_obj_create( dt, m, 1, 0, 0, &t ); bli_obj_create( dt, m, 1, 0, 0, &v ); bli_obj_create( dt, k, 1, 0, 0, &w1 ); bli_obj_create( dt, k, 1, 0, 0, &w2 ); bli_obj_create( dt, m, 1, 0, 0, &z ); libblis_test_vobj_randomize( params, TRUE, &t ); bli_hemv( &BLIS_ONE, c, &t, &BLIS_ZERO, &v ); bli_gemv( &BLIS_ONE, &ah, &t, &BLIS_ZERO, &w2 ); bli_gemv( &BLIS_ONE, &bh, &t, &BLIS_ZERO, &w1 ); bli_gemv( alpha, a, &w1, &BLIS_ZERO, &z ); bli_gemv( &alphac, b, &w2, &BLIS_ONE, &z ); bli_hemv( beta, c_orig, &t, &BLIS_ONE, &z ); bli_subv( &z, &v ); bli_normfv( &v, &norm ); bli_getsc( &norm, resid, &junk ); bli_obj_free( &t ); bli_obj_free( &v ); bli_obj_free( &w1 ); bli_obj_free( &w2 ); bli_obj_free( &z ); }
void 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 }
void libblis_test_herk_check( obj_t* alpha, obj_t* a, obj_t* beta, obj_t* c, obj_t* c_orig, double* resid ) { num_t dt = bli_obj_datatype( *c ); num_t dt_real = bli_obj_datatype_proj_to_real( *c ); dim_t m = bli_obj_length( *c ); dim_t k = bli_obj_width_after_trans( *a ); obj_t ah; obj_t kappa, norm; obj_t t, v, w, z; double junk; // // Pre-conditions: // - a is randomized. // - c_orig is randomized and Hermitian. // Note: // - alpha and beta must be real-valued. // // Under these conditions, we assume that the implementation for // // C := beta * C_orig + alpha * transa(A) * transa(A)^H // // is functioning correctly if // // fnorm( v - z ) // // is negligible, where // // v = C * t // z = ( beta * C_orig + alpha * transa(A) * transa(A)^H ) * t // = beta * C_orig * t + alpha * transa(A) * transa(A)^H * t // = beta * C_orig * t + alpha * transa(A) * w // = beta * C_orig * t + z // bli_obj_alias_with_trans( BLIS_CONJ_TRANSPOSE, *a, ah ); bli_obj_scalar_init_detached( dt, &kappa ); bli_obj_scalar_init_detached( dt_real, &norm ); bli_obj_create( dt, m, 1, 0, 0, &t ); bli_obj_create( dt, m, 1, 0, 0, &v ); bli_obj_create( dt, k, 1, 0, 0, &w ); bli_obj_create( dt, m, 1, 0, 0, &z ); bli_randv( &t ); bli_setsc( 1.0/( double )m, 0.0, &kappa ); bli_scalv( &kappa, &t ); bli_hemv( &BLIS_ONE, c, &t, &BLIS_ZERO, &v ); bli_gemv( &BLIS_ONE, &ah, &t, &BLIS_ZERO, &w ); bli_gemv( alpha, a, &w, &BLIS_ZERO, &z ); bli_hemv( beta, c_orig, &t, &BLIS_ONE, &z ); bli_subv( &z, &v ); bli_fnormv( &v, &norm ); bli_getsc( &norm, resid, &junk ); bli_obj_free( &t ); bli_obj_free( &v ); bli_obj_free( &w ); bli_obj_free( &z ); }
void libblis_test_gemm_md_check ( test_params_t* params, obj_t* alpha, obj_t* a, obj_t* b, obj_t* beta, obj_t* c, obj_t* c_orig, double* resid ) { num_t dt_real = bli_obj_dt_proj_to_real( c ); num_t dt_comp = bli_obj_dt_proj_to_complex( c ); num_t dt; dim_t m = bli_obj_length( c ); dim_t n = bli_obj_width( c ); dim_t k = bli_obj_width_after_trans( a ); obj_t norm; obj_t t, v, w, z; double junk; // Compute our reference checksum in the real domain if all operands // are real, and in the complex domain otherwise. Also implicit in this // is that we use the storage precision of C to determine the precision // in which we perform the reference checksum. if ( bli_obj_is_real( a ) && bli_obj_is_real( b ) && bli_obj_is_real( c ) ) dt = dt_real; else dt = dt_comp; // This function works in a manner similar to that of the function // libblis_test_gemm_check(), except that we project a, b, and c into // the complex domain (regardless of their storage datatype), and then // proceed with the checking accordingly. obj_t a2, b2, c2, c0; bli_obj_scalar_init_detached( dt_real, &norm ); bli_obj_create( dt, n, 1, 0, 0, &t ); bli_obj_create( dt, m, 1, 0, 0, &v ); bli_obj_create( dt, k, 1, 0, 0, &w ); bli_obj_create( dt, m, 1, 0, 0, &z ); libblis_test_vobj_randomize( params, TRUE, &t ); // We need to zero out the imaginary part of t in order for our // checks to work in all cases. Otherwise, the imaginary parts // could affect intermediate products, depending on the order that // they are executed. bli_setiv( &BLIS_ZERO, &t ); // Create complex equivalents of a, b, c_orig, and c. bli_obj_create( dt, m, k, 0, 0, &a2 ); bli_obj_create( dt, k, n, 0, 0, &b2 ); bli_obj_create( dt, m, n, 0, 0, &c2 ); bli_obj_create( dt, m, n, 0, 0, &c0 ); // Cast a, b, c_orig, and c into the datatype of our temporary objects. bli_castm( a, &a2 ); bli_castm( b, &b2 ); bli_castm( c_orig, &c2 ); bli_castm( c, &c0 ); bli_gemv( &BLIS_ONE, &c0, &t, &BLIS_ZERO, &v ); #if 0 if ( bli_obj_is_scomplex( c ) && bli_obj_is_float( a ) && bli_obj_is_float( b ) ) { bli_printm( "test_gemm.c: a", a, "%7.3f", "" ); bli_printm( "test_gemm.c: b", b, "%7.3f", "" ); bli_printm( "test_gemm.c: c orig", c_orig, "%7.3f", "" ); bli_printm( "test_gemm.c: c computed", c, "%7.3f", "" ); } #endif #if 0 bli_gemm( alpha, &a2, &b2, beta, &c2 ); bli_gemv( &BLIS_ONE, &c2, &t, &BLIS_ZERO, &z ); if ( bli_obj_is_real( c ) ) bli_setiv( &BLIS_ZERO, &z ); #else bli_gemv( &BLIS_ONE, &b2, &t, &BLIS_ZERO, &w ); bli_gemv( alpha, &a2, &w, &BLIS_ZERO, &z ); bli_gemv( beta, &c2, &t, &BLIS_ONE, &z ); if ( bli_obj_is_real( c ) ) bli_setiv( &BLIS_ZERO, &z ); #endif bli_subv( &z, &v ); bli_normfv( &v, &norm ); bli_getsc( &norm, resid, &junk ); bli_obj_free( &t ); bli_obj_free( &v ); bli_obj_free( &w ); bli_obj_free( &z ); bli_obj_free( &a2 ); bli_obj_free( &b2 ); bli_obj_free( &c2 ); bli_obj_free( &c0 ); }
void 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 ); }
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 ); } } }
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; }
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 ); } }
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 }
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 ) ); } }
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 ) ); } }
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 ) ); }
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 ); }
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; }
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 ) ); }
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 ); }
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; }
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 ); }
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 ); } }
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 ) ); } }