FLA_Error FLA_Syrk_ut_unb_var3( FLA_Obj alpha, FLA_Obj A, FLA_Obj beta, FLA_Obj C )
{
FLA_Obj AL, AR, A0, a1, A2;
FLA_Obj CTL, CTR, C00, c01, C02,
CBL, CBR, c10t, gamma11, c12t,
C20, c21, C22;
FLA_Scalr_external( FLA_UPPER_TRIANGULAR, beta, C );
FLA_Part_1x2( A, &AL, &AR, 0, FLA_RIGHT );
FLA_Part_2x2( C, &CTL, &CTR,
&CBL, &CBR, 0, 0, FLA_BR );
while ( FLA_Obj_width( AR ) < FLA_Obj_width( A ) ){
FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, &a1, /**/ &A2,
1, FLA_LEFT );
FLA_Repart_2x2_to_3x3( CTL, /**/ CTR, &C00, &c01, /**/ &C02,
&c10t, &gamma11, /**/ &c12t,
/* ************* */ /* ************************** */
CBL, /**/ CBR, &C20, &c21, /**/ &C22,
1, 1, FLA_TL );
/*------------------------------------------------------------*/
/* c12t = c12t + A2' * a1 */
FLA_Gemv_external( FLA_TRANSPOSE, alpha, A2, a1, FLA_ONE, c12t );
/* gamma11 = gamma11 + a1 * a1' */
FLA_Dots_external( alpha, a1, a1, FLA_ONE, gamma11 );
/*------------------------------------------------------------*/
FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, /**/ a1, A2,
FLA_RIGHT );
FLA_Cont_with_3x3_to_2x2( &CTL, /**/ &CTR, C00, /**/ c01, C02,
/* ************** */ /* ************************ */
c10t, /**/ gamma11, c12t,
&CBL, /**/ &CBR, C20, /**/ c21, C22,
FLA_BR );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Gemm_tn_unb_var1( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C )
{
FLA_Obj AL, AR, A0, a1, A2;
FLA_Obj CT, C0,
CB, c1t,
C2;
FLA_Scal_external( beta, C );
FLA_Part_1x2( A, &AL, &AR, 0, FLA_LEFT );
FLA_Part_2x1( C, &CT,
&CB, 0, FLA_TOP );
while ( FLA_Obj_width( AL ) < FLA_Obj_width( A ) ){
FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, /**/ &a1, &A2,
1, FLA_RIGHT );
FLA_Repart_2x1_to_3x1( CT, &C0,
/* ** */ /* *** */
&c1t,
CB, &C2, 1, FLA_BOTTOM );
/*------------------------------------------------------------*/
/* c1t = a1' * B + c1t */
/* c1t' = B' * a1 + c1t' */
FLA_Gemv_external( FLA_TRANSPOSE, alpha, B, a1, FLA_ONE, c1t );
/*------------------------------------------------------------*/
FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, a1, /**/ A2,
FLA_LEFT );
FLA_Cont_with_3x1_to_2x1( &CT, C0,
c1t,
/* ** */ /* *** */
&CB, C2, FLA_TOP );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Gemm_nt_unb_var3( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C )
{
FLA_Obj BT, B0,
BB, b1t,
B2;
FLA_Obj CL, CR, C0, c1, C2;
FLA_Scal_external( beta, C );
FLA_Part_2x1( B, &BT,
&BB, 0, FLA_TOP );
FLA_Part_1x2( C, &CL, &CR, 0, FLA_LEFT );
while ( FLA_Obj_length( BT ) < FLA_Obj_length( B ) ){
FLA_Repart_2x1_to_3x1( BT, &B0,
/* ** */ /* *** */
&b1t,
BB, &B2, 1, FLA_BOTTOM );
FLA_Repart_1x2_to_1x3( CL, /**/ CR, &C0, /**/ &c1, &C2,
1, FLA_RIGHT );
/*------------------------------------------------------------*/
/* c1 = A * b1t + c1 */
FLA_Gemv_external( FLA_NO_TRANSPOSE, alpha, A, b1t, FLA_ONE, c1 );
/*------------------------------------------------------------*/
FLA_Cont_with_3x1_to_2x1( &BT, B0,
b1t,
/* ** */ /* *** */
&BB, B2, FLA_TOP );
FLA_Cont_with_1x3_to_1x2( &CL, /**/ &CR, C0, c1, /**/ C2,
FLA_LEFT );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Gemv( FLA_Trans transa, FLA_Obj alpha, FLA_Obj A, FLA_Obj x, FLA_Obj beta, FLA_Obj y )
{
FLA_Error r_val;
// Check parameters.
if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
FLA_Gemv_check( transa, alpha, A, x, beta, y );
#ifdef FLA_ENABLE_BLAS2_FRONT_END_CNTL_TREES
// Invoke FLA_Gemv_internal() with flat control tree that simply calls
// external wrapper.
r_val = FLA_Gemv_internal( transa, alpha, A, x, beta, y, fla_gemv_cntl_blas );
#else
r_val = FLA_Gemv_external( transa, alpha, A, x, beta, y );
#endif
return r_val;
}
FLA_Error FLA_Gemm_nn_unb_var3( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C )
{
FLA_Obj BL, BR, B0, b1, B2;
FLA_Obj CL, CR, C0, c1, C2;
FLA_Scal_external( beta, C );
FLA_Part_1x2( B, &BL, &BR, 0, FLA_LEFT );
FLA_Part_1x2( C, &CL, &CR, 0, FLA_LEFT );
while ( FLA_Obj_width( BL ) < FLA_Obj_width( B ) ){
FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, /**/ &b1, &B2,
1, FLA_RIGHT );
FLA_Repart_1x2_to_1x3( CL, /**/ CR, &C0, /**/ &c1, &C2,
1, FLA_RIGHT );
/*------------------------------------------------------------*/
/* c1 = A * b1 + c1 */
FLA_Gemv_external( FLA_NO_TRANSPOSE, alpha, A, b1, FLA_ONE, c1 );
/*------------------------------------------------------------*/
FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, b1, /**/ B2,
FLA_LEFT );
FLA_Cont_with_1x3_to_1x2( &CL, /**/ &CR, C0, c1, /**/ C2,
FLA_LEFT );
}
return FLA_SUCCESS;
}
void libfla_test_qrut_experiment( test_params_t params,
unsigned int var,
char* sc_str,
FLA_Datatype datatype,
unsigned int p_cur,
unsigned int pci,
unsigned int n_repeats,
signed int impl,
double* perf,
double* residual )
{
dim_t b_flash = params.b_flash;
dim_t b_alg_flat = params.b_alg_flat;
double time_min = 1e9;
double time;
unsigned int i;
unsigned int m, n;
unsigned int min_m_n;
signed int m_input = -2;
signed int n_input = -1;
FLA_Obj A, T, x, b, y, norm;
FLA_Obj A_save;
FLA_Obj A_test, T_test, x_test, b_test;
// Determine the dimensions.
if ( m_input < 0 ) m = p_cur * abs(m_input);
else m = p_cur;
if ( n_input < 0 ) n = p_cur * abs(n_input);
else n = p_cur;
// Compute the minimum dimension.
min_m_n = min( m, n );
// Create the matrices for the current operation.
libfla_test_obj_create( datatype, FLA_NO_TRANSPOSE, sc_str[0], m, n, &A );
if ( impl == FLA_TEST_FLAT_FRONT_END ||
( impl == FLA_TEST_FLAT_BLK_VAR && var == 1 ) )
libfla_test_obj_create( datatype, FLA_NO_TRANSPOSE, sc_str[1], b_alg_flat, min_m_n, &T );
else if ( var == 2 )
libfla_test_obj_create( datatype, FLA_NO_TRANSPOSE, sc_str[1], min_m_n, min_m_n, &T );
else
libfla_test_obj_create( datatype, FLA_NO_TRANSPOSE, sc_str[1], 1, min_m_n, &T );
// Initialize the test matrices.
FLA_Random_matrix( A );
// Save the original object contents in a temporary object.
FLA_Obj_create_copy_of( FLA_NO_TRANSPOSE, A, &A_save );
// Create vectors to form a linear system.
FLA_Obj_create( datatype, n, 1, 0, 0, &x );
FLA_Obj_create( datatype, m, 1, 0, 0, &b );
FLA_Obj_create( datatype, n, 1, 0, 0, &y );
// Create a real scalar object to hold the norm of A.
FLA_Obj_create( FLA_Obj_datatype_proj_to_real( A ), 1, 1, 0, 0, &norm );
// Create a random right-hand side vector.
FLA_Random_matrix( b );
// Use hierarchical matrices if we're testing the FLASH front-end.
if ( impl == FLA_TEST_HIER_FRONT_END )
{
FLASH_QR_UT_create_hier_matrices( A, 1, &b_flash, &A_test, &T_test );
FLASH_Obj_create_hier_copy_of_flat( b, 1, &b_flash, &b_test );
FLASH_Obj_create_hier_copy_of_flat( x, 1, &b_flash, &x_test );
}
else
{
A_test = A;
T_test = T;
}
// Create a control tree for the individual variants.
if ( impl == FLA_TEST_FLAT_UNB_VAR ||
impl == FLA_TEST_FLAT_OPT_VAR ||
impl == FLA_TEST_FLAT_BLK_VAR )
libfla_test_qrut_cntl_create( var, b_alg_flat );
// Repeat the experiment n_repeats times and record results.
for ( i = 0; i < n_repeats; ++i )
{
if ( impl == FLA_TEST_HIER_FRONT_END )
FLASH_Obj_hierarchify( A_save, A_test );
else
FLA_Copy_external( A_save, A_test );
time = FLA_Clock();
libfla_test_qrut_impl( impl, A_test, T_test );
time = FLA_Clock() - time;
time_min = min( time_min, time );
}
// Perform a linear solve with the result.
if ( impl == FLA_TEST_HIER_FRONT_END )
{
FLASH_QR_UT_solve( A_test, T_test, b_test, x_test );
FLASH_Obj_flatten( x_test, x );
}
else
{
FLA_QR_UT_solve( A_test, T_test, b, x );
}
// Free the hierarchical matrices if we're testing the FLASH front-end.
if ( impl == FLA_TEST_HIER_FRONT_END )
{
FLASH_Obj_free( &A_test );
FLASH_Obj_free( &T_test );
FLASH_Obj_free( &b_test );
FLASH_Obj_free( &x_test );
}
// Free the control trees if we're testing the variants.
if ( impl == FLA_TEST_FLAT_UNB_VAR ||
impl == FLA_TEST_FLAT_OPT_VAR ||
impl == FLA_TEST_FLAT_BLK_VAR )
libfla_test_qrut_cntl_free();
// Compute the performance of the best experiment repeat.
*perf = ( 2.0 * m * n * n -
( 2.0 / 3.0 ) * n * n * n ) / time_min / FLOPS_PER_UNIT_PERF;
if ( FLA_Obj_is_complex( A ) ) *perf *= 4.0;
// Compute the residual.
FLA_Gemv_external( FLA_NO_TRANSPOSE, FLA_ONE, A_save, x, FLA_MINUS_ONE, b );
FLA_Gemv_external( FLA_CONJ_TRANSPOSE, FLA_ONE, A_save, b, FLA_ZERO, y );
FLA_Nrm2_external( y, norm );
FLA_Obj_extract_real_scalar( norm, residual );
// Free the supporting flat objects.
FLA_Obj_free( &x );
FLA_Obj_free( &b );
FLA_Obj_free( &y );
FLA_Obj_free( &norm );
FLA_Obj_free( &A_save );
// Free the flat test matrices.
FLA_Obj_free( &A );
FLA_Obj_free( &T );
}
int main( int argc, char *argv[] )
{
int
i, j,
n_threads,
n_repeats,
n_trials,
increment,
begin,
sorting,
caching,
work_stealing,
data_affinity;
dim_t
size,
nb_alg;
FLA_Datatype
datatype = FLA_DOUBLE;
FLA_Obj
A, x, b, b_norm,
AH, pH, bH;
double
b_norm_value,
dtime,
*dtimes,
*flops;
#ifndef FLA_ENABLE_WINDOWS_BUILD
char
output_file_m[100];
FILE
*fpp;
#endif
fprintf( stdout, "%c Enter number of repeats: ", '%' );
scanf( "%d", &n_repeats );
fprintf( stdout, "%c %d\n", '%', n_repeats );
fprintf( stdout, "%c Enter blocksize: ", '%' );
scanf( "%u", &nb_alg );
fprintf( stdout, "%c %u\n", '%', nb_alg );
fprintf( stdout, "%c Enter problem size parameters: first, inc, num: ", '%' );
scanf( "%d%d%d", &begin, &increment, &n_trials );
fprintf( stdout, "%c %d %d %d\n", '%', begin, increment, n_trials );
fprintf( stdout, "%c Enter number of threads: ", '%' );
scanf( "%d", &n_threads );
fprintf( stdout, "%c %d\n", '%', n_threads );
fprintf( stdout, "%c Enter SuperMatrix parameters: sorting, caching, work stealing, data affinity: ", '%' );
scanf( "%d%d%d%d", &sorting, &caching, &work_stealing, &data_affinity );
fprintf( stdout, "%c %s %s %s %s\n\n", '%', ( sorting ? "TRUE" : "FALSE" ), ( caching ? "TRUE" : "FALSE" ), ( work_stealing ? "TRUE" : "FALSE" ), ( data_affinity ? ( data_affinity == 1 ? "FLASH_QUEUE_AFFINITY_2D_BLOCK_CYCLIC" : "FLASH_QUEUE_AFFINITY_OTHER" ) : "FLASH_QUEUE_AFFINITY_NONE" ) );
#ifdef FLA_ENABLE_WINDOWS_BUILD
fprintf( stdout, "%s_%u = [\n", OUTPUT_FILE, nb_alg );
#else
sprintf( output_file_m, "%s/%s_output.m", OUTPUT_PATH, OUTPUT_FILE );
fpp = fopen( output_file_m, "a" );
fprintf( fpp, "%%\n" );
fprintf( fpp, "%% | Matrix Size | FLASH |\n" );
fprintf( fpp, "%% | n x n | GFlops |\n" );
fprintf( fpp, "%% -----------------------------\n" );
fprintf( fpp, "%s_%u = [\n", OUTPUT_FILE, nb_alg );
#endif
FLA_Init();
dtimes = ( double * ) FLA_malloc( n_repeats * sizeof( double ) );
flops = ( double * ) FLA_malloc( n_trials * sizeof( double ) );
FLASH_Queue_set_num_threads( n_threads );
FLASH_Queue_set_sorting( sorting );
FLASH_Queue_set_caching( caching );
FLASH_Queue_set_work_stealing( work_stealing );
FLASH_Queue_set_data_affinity( data_affinity );
for ( i = 0; i < n_trials; i++ )
{
size = begin + i * increment;
FLA_Obj_create( datatype, size, size, 0, 0, &A );
FLA_Obj_create( datatype, size, 1, 0, 0, &x );
FLA_Obj_create( datatype, size, 1, 0, 0, &b );
FLA_Obj_create( datatype, 1, 1, 0, 0, &b_norm );
for ( j = 0; j < n_repeats; j++ )
{
FLA_Random_matrix( A );
FLA_Random_matrix( b );
FLASH_Obj_create_hier_copy_of_flat( A, 1, &nb_alg, &AH );
FLASH_Obj_create( FLA_INT, size, 1, 1, &nb_alg, &pH );
FLASH_Obj_create_hier_copy_of_flat( b, 1, &nb_alg, &bH );
dtime = FLA_Clock();
FLASH_LU_piv( AH, pH );
dtime = FLA_Clock() - dtime;
dtimes[j] = dtime;
FLASH_Apply_pivots( FLA_LEFT, FLA_NO_TRANSPOSE, pH, bH );
FLASH_Trsv( FLA_LOWER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_UNIT_DIAG,
AH, bH );
FLASH_Trsv( FLA_UPPER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_NONUNIT_DIAG,
AH, bH );
FLASH_Obj_free( &AH );
FLASH_Obj_free( &pH );
FLASH_Obj_flatten( bH, x );
FLASH_Obj_free( &bH );
}
dtime = dtimes[0];
for ( j = 1; j < n_repeats; j++ )
dtime = min( dtime, dtimes[j] );
flops[i] = 2.0 / 3.0 * size * size * size / dtime / 1e9;
FLA_Gemv_external( FLA_NO_TRANSPOSE, FLA_ONE,
A, x, FLA_MINUS_ONE, b );
FLA_Nrm2_external( b, b_norm );
FLA_Obj_extract_real_scalar( b_norm, &b_norm_value );
#ifdef FLA_ENABLE_WINDOWS_BUILD
fprintf( stdout, " %d %6.3f %le\n", size, flops[i], b_norm_value );
#else
fprintf( fpp, " %d %6.3f\n", size, flops[i] );
fprintf( stdout, "Time: %e | GFlops: %6.3f\n", dtime, flops[i] );
fprintf( stdout, "Matrix size: %u x %u | nb_alg: %u\n",
size, size, nb_alg );
fprintf( stdout, "Norm of difference: %le\n\n", b_norm_value );
#endif
FLA_Obj_free( &A );
FLA_Obj_free( &x );
FLA_Obj_free( &b );
FLA_Obj_free( &b_norm );
}
#ifdef FLA_ENABLE_WINDOWS_BUILD
fprintf( stdout, "];\n\n" );
#else
fprintf( fpp, "];\n" );
fflush( fpp );
fclose( fpp );
#endif
FLA_free( dtimes );
FLA_free( flops );
FLA_Finalize();
return 0;
}
FLA_Error FLA_Symm_lu_unb_var1( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C )
{
FLA_Obj ATL, ATR, A00, a01, A02,
ABL, ABR, a10t, alpha11, a12t,
A20, a21, A22;
FLA_Obj BT, B0,
BB, b1t,
B2;
FLA_Obj CT, C0,
CB, c1t,
C2;
FLA_Scal_external( beta, C );
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, 0, 0, FLA_TL );
FLA_Part_2x1( B, &BT,
&BB, 0, FLA_TOP );
FLA_Part_2x1( C, &CT,
&CB, 0, FLA_TOP );
while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ){
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &a01, &A02,
/* ************* */ /* ************************** */
&a10t, /**/ &alpha11, &a12t,
ABL, /**/ ABR, &A20, /**/ &a21, &A22,
1, 1, FLA_BR );
FLA_Repart_2x1_to_3x1( BT, &B0,
/* ** */ /* ** */
&b1t,
BB, &B2, 1, FLA_BOTTOM );
FLA_Repart_2x1_to_3x1( CT, &C0,
/* ** */ /* ** */
&c1t,
CB, &C2, 1, FLA_BOTTOM );
/*------------------------------------------------------------*/
/* C0 = C0 + a01 * b1t */
FLA_Ger_external( alpha, a01, b1t, C0 );
/* c1t = c1t + a01' * B0 */
/* c1t' = c1t' + B0' * a01 */
FLA_Gemv_external( FLA_TRANSPOSE, alpha, B0, a01, FLA_ONE, c1t );
/* c1t = c1t + alpha11 * b1t */
FLA_Axpys_external( alpha, alpha11, b1t, FLA_ONE, c1t );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, a01, /**/ A02,
a10t, alpha11, /**/ a12t,
/* ************** */ /* ************************ */
&ABL, /**/ &ABR, A20, a21, /**/ A22,
FLA_TL );
FLA_Cont_with_3x1_to_2x1( &BT, B0,
b1t,
/* ** */ /* ** */
&BB, B2, FLA_TOP );
FLA_Cont_with_3x1_to_2x1( &CT, C0,
c1t,
/* ** */ /* ** */
&CB, C2, FLA_TOP );
}
return FLA_SUCCESS;
}
void libfla_test_symm_experiment( test_params_t params,
unsigned int var,
char* sc_str,
FLA_Datatype datatype,
unsigned int p_cur,
unsigned int pci,
unsigned int n_repeats,
signed int impl,
double* perf,
double* residual )
{
dim_t b_flash = params.b_flash;
dim_t b_alg_flat = params.b_alg_flat;
double time_min = 1e9;
double time;
unsigned int i;
unsigned int m;
signed int m_input = -1;
unsigned int n;
signed int n_input = -1;
FLA_Side side;
FLA_Uplo uplo;
FLA_Obj A, B, C, x, y, z, w, norm;
FLA_Obj alpha, beta;
FLA_Obj C_save;
FLA_Obj A_test, B_test, C_test;
// Determine the dimensions.
if ( m_input < 0 ) m = p_cur / abs(m_input);
else m = p_cur;
if ( n_input < 0 ) n = p_cur / abs(n_input);
else n = p_cur;
// Translate parameter characters to libflame constants.
FLA_Param_map_char_to_flame_side( &pc_str[pci][0], &side );
FLA_Param_map_char_to_flame_uplo( &pc_str[pci][1], &uplo );
// Create the matrices for the current operation.
if ( side == FLA_LEFT )
{
libfla_test_obj_create( datatype, FLA_NO_TRANSPOSE, sc_str[0], m, m, &A );
// Create vectors for use in test.
FLA_Obj_create( datatype, n, 1, 0, 0, &x );
FLA_Obj_create( datatype, m, 1, 0, 0, &y );
FLA_Obj_create( datatype, m, 1, 0, 0, &z );
FLA_Obj_create( datatype, m, 1, 0, 0, &w );
}
else
{
libfla_test_obj_create( datatype, FLA_NO_TRANSPOSE, sc_str[0], n, n, &A );
// Create vectors for use in test.
FLA_Obj_create( datatype, n, 1, 0, 0, &x );
FLA_Obj_create( datatype, m, 1, 0, 0, &y );
FLA_Obj_create( datatype, m, 1, 0, 0, &z );
FLA_Obj_create( datatype, n, 1, 0, 0, &w );
}
libfla_test_obj_create( datatype, FLA_NO_TRANSPOSE, sc_str[1], m, n, &B );
libfla_test_obj_create( datatype, FLA_NO_TRANSPOSE, sc_str[2], m, n, &C );
// Create a norm scalar.
FLA_Obj_create( FLA_Obj_datatype_proj_to_real( A ), 1, 1, 0, 0, &norm );
// Initialize the test matrices.
FLA_Random_symm_matrix( uplo, A );
FLA_Random_matrix( B );
FLA_Random_matrix( C );
// Initialize the test vectors.
FLA_Random_matrix( x );
FLA_Set( FLA_ZERO, y );
FLA_Set( FLA_ZERO, z );
FLA_Set( FLA_ZERO, w );
// Set constants.
alpha = FLA_TWO;
beta = FLA_MINUS_ONE;
// Save the original object contents in a temporary object.
FLA_Obj_create_copy_of( FLA_NO_TRANSPOSE, C, &C_save );
// Use hierarchical matrices if we're testing the FLASH front-end.
if ( impl == FLA_TEST_HIER_FRONT_END )
{
FLASH_Obj_create_hier_copy_of_flat( A, 1, &b_flash, &A_test );
FLASH_Obj_create_hier_copy_of_flat( B, 1, &b_flash, &B_test );
FLASH_Obj_create_hier_copy_of_flat( C, 1, &b_flash, &C_test );
}
else
{
A_test = A;
B_test = B;
C_test = C;
}
// Create a control tree for the individual variants.
if ( impl == FLA_TEST_FLAT_UNB_VAR ||
impl == FLA_TEST_FLAT_OPT_VAR ||
impl == FLA_TEST_FLAT_BLK_VAR ||
impl == FLA_TEST_FLAT_UNB_EXT ||
impl == FLA_TEST_FLAT_BLK_EXT )
libfla_test_symm_cntl_create( var, b_alg_flat );
// Repeat the experiment n_repeats times and record results.
for ( i = 0; i < n_repeats; ++i )
{
if ( impl == FLA_TEST_HIER_FRONT_END )
FLASH_Obj_hierarchify( C_save, C_test );
else
FLA_Copy_external( C_save, C_test );
time = FLA_Clock();
libfla_test_symm_impl( impl, side, uplo, alpha, A_test, B_test, beta, C_test );
time = FLA_Clock() - time;
time_min = min( time_min, time );
}
// Copy the solution to flat matrix X.
if ( impl == FLA_TEST_HIER_FRONT_END )
{
FLASH_Obj_flatten( C_test, C );
}
else
{
// No action needed since C_test and C refer to the same object.
}
// Free the hierarchical matrices if we're testing the FLASH front-end.
if ( impl == FLA_TEST_HIER_FRONT_END )
{
FLASH_Obj_free( &A_test );
FLASH_Obj_free( &B_test );
FLASH_Obj_free( &C_test );
}
// Free the control trees if we're testing the variants.
if ( impl == FLA_TEST_FLAT_UNB_VAR ||
impl == FLA_TEST_FLAT_OPT_VAR ||
impl == FLA_TEST_FLAT_BLK_VAR ||
impl == FLA_TEST_FLAT_UNB_EXT ||
impl == FLA_TEST_FLAT_BLK_EXT )
libfla_test_symm_cntl_free();
// Compute the performance of the best experiment repeat.
if ( side == FLA_LEFT )
*perf = ( 1 * m * m * n ) / time_min / FLOPS_PER_UNIT_PERF;
else
*perf = ( 1 * m * n * n ) / time_min / FLOPS_PER_UNIT_PERF;
if ( FLA_Obj_is_complex( A ) ) *perf *= 4.0;
// Compute:
// y = C * x
// and compare to
// z = ( beta * C_orig + alpha * A * B ) x (side = left)
// z = ( beta * C_orig + alpha * B * A ) x (side = right)
FLA_Gemv_external( FLA_NO_TRANSPOSE, FLA_ONE, C, x, FLA_ZERO, y );
if ( side == FLA_LEFT )
{
FLA_Gemv_external( FLA_NO_TRANSPOSE, FLA_ONE, B, x, FLA_ZERO, w );
FLA_Symv_external( uplo, alpha, A, w, FLA_ZERO, z );
}
else
{
FLA_Symv_external( uplo, FLA_ONE, A, x, FLA_ZERO, w );
FLA_Gemv_external( FLA_NO_TRANSPOSE, alpha, B, w, FLA_ZERO, z );
}
FLA_Gemv_external( FLA_NO_TRANSPOSE, beta, C_save, x, FLA_ONE, z );
// Compute || y - z ||.
//FLA_Axpy_external( FLA_MINUS_ONE, y, z );
//FLA_Nrm2_external( z, norm );
//FLA_Obj_extract_real_scalar( norm, residual );
*residual = FLA_Max_elemwise_diff( y, z );
// Free the supporting flat objects.
FLA_Obj_free( &C_save );
// Free the flat test matrices.
FLA_Obj_free( &A );
FLA_Obj_free( &B );
FLA_Obj_free( &C );
FLA_Obj_free( &x );
FLA_Obj_free( &y );
FLA_Obj_free( &z );
FLA_Obj_free( &w );
FLA_Obj_free( &norm );
}
FLA_Error FLA_Syr2k_lt_unb_var6( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C )
{
FLA_Obj AL, AR, A0, a1, A2;
FLA_Obj BL, BR, B0, b1, B2;
FLA_Obj CTL, CTR, C00, c01, C02,
CBL, CBR, c10t, gamma11, c12t,
C20, c21, C22;
FLA_Scalr_external( FLA_LOWER_TRIANGULAR, beta, C );
FLA_Part_1x2( A, &AL, &AR, 0, FLA_RIGHT );
FLA_Part_1x2( B, &BL, &BR, 0, FLA_RIGHT );
FLA_Part_2x2( C, &CTL, &CTR,
&CBL, &CBR, 0, 0, FLA_BR );
while ( FLA_Obj_width( AR ) < FLA_Obj_width( A ) ){
FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, &a1, /**/ &A2,
1, FLA_LEFT );
FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, &b1, /**/ &B2,
1, FLA_LEFT );
FLA_Repart_2x2_to_3x3( CTL, /**/ CTR, &C00, &c01, /**/ &C02,
&c10t, &gamma11, /**/ &c12t,
/* ************* */ /* ************************** */
CBL, /**/ CBR, &C20, &c21, /**/ &C22,
1, 1, FLA_TL );
/*------------------------------------------------------------*/
/* c10t = c10t + a1' * B0 */
FLA_Gemv_external( FLA_TRANSPOSE, alpha, B0, a1, FLA_ONE, c10t );
/* c21 = c21 + B2' * a1 */
FLA_Gemv_external( FLA_TRANSPOSE, alpha, B2, a1, FLA_ONE, c21 );
/* gamma11 = gamma11 + a1' * b1 + b1' * a1 */
FLA_Dot2s_external( alpha, a1, b1, FLA_ONE, gamma11 );
/*------------------------------------------------------------*/
FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, /**/ a1, A2,
FLA_RIGHT );
FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, /**/ b1, B2,
FLA_RIGHT );
FLA_Cont_with_3x3_to_2x2( &CTL, /**/ &CTR, C00, /**/ c01, C02,
/* ************** */ /* ************************ */
c10t, /**/ gamma11, c12t,
&CBL, /**/ &CBR, C20, /**/ c21, C22,
FLA_BR );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Her2k_uh_unb_var2( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C )
{
FLA_Obj AL, AR, A0, a1, A2;
FLA_Obj BL, BR, B0, b1, B2;
FLA_Obj CTL, CTR, C00, c01, C02,
CBL, CBR, c10t, gamma11, c12t,
C20, c21, C22;
FLA_Scalr_external( FLA_UPPER_TRIANGULAR, beta, C );
FLA_Part_1x2( A, &AL, &AR, 0, FLA_LEFT );
FLA_Part_1x2( B, &BL, &BR, 0, FLA_LEFT );
FLA_Part_2x2( C, &CTL, &CTR,
&CBL, &CBR, 0, 0, FLA_TL );
while ( FLA_Obj_width( AL ) < FLA_Obj_width( A ) ){
FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, /**/ &a1, &A2,
1, FLA_RIGHT );
FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, /**/ &b1, &B2,
1, FLA_RIGHT );
FLA_Repart_2x2_to_3x3( CTL, /**/ CTR, &C00, /**/ &c01, &C02,
/* ************* */ /* ************************** */
&c10t, /**/ &gamma11, &c12t,
CBL, /**/ CBR, &C20, /**/ &c21, &C22,
1, 1, FLA_BR );
/*------------------------------------------------------------*/
/* c01 = c01 + B0' * a1 */
FLA_Gemv_external( FLA_CONJ_TRANSPOSE, alpha, B0, a1, FLA_ONE, c01 );
/* c12t = c12t + a1' * B2 */
FLA_Gemvc_external( FLA_TRANSPOSE, FLA_CONJUGATE, alpha, B2, a1, FLA_ONE, c12t );
/* gamma11 = gamma11 + a1' * b1 + b1' * a1 */
FLA_Dot2cs_external( FLA_CONJUGATE, alpha, a1, b1, FLA_ONE, gamma11 );
/*------------------------------------------------------------*/
FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, a1, /**/ A2,
FLA_LEFT );
FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, b1, /**/ B2,
FLA_LEFT );
FLA_Cont_with_3x3_to_2x2( &CTL, /**/ &CTR, C00, c01, /**/ C02,
c10t, gamma11, /**/ c12t,
/* ************** */ /* ************************ */
&CBL, /**/ &CBR, C20, c21, /**/ C22,
FLA_TL );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Her2k_un_unb_var6( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C )
{
FLA_Obj AT, A0,
AB, a1t,
A2;
FLA_Obj BT, B0,
BB, b1t,
B2;
FLA_Obj CTL, CTR, C00, c01, C02,
CBL, CBR, c10t, gamma11, c12t,
C20, c21, C22;
FLA_Scalr_external( FLA_UPPER_TRIANGULAR, beta, C );
FLA_Part_2x1( A, &AT,
&AB, 0, FLA_BOTTOM );
FLA_Part_2x1( B, &BT,
&BB, 0, FLA_BOTTOM );
FLA_Part_2x2( C, &CTL, &CTR,
&CBL, &CBR, 0, 0, FLA_BR );
while ( FLA_Obj_length( AB ) < FLA_Obj_length( A ) ){
FLA_Repart_2x1_to_3x1( AT, &A0,
&a1t,
/* ** */ /* ** */
AB, &A2, 1, FLA_TOP );
FLA_Repart_2x1_to_3x1( BT, &B0,
&b1t,
/* ** */ /* ** */
BB, &B2, 1, FLA_TOP );
FLA_Repart_2x2_to_3x3( CTL, /**/ CTR, &C00, &c01, /**/ &C02,
&c10t, &gamma11, /**/ &c12t,
/* ************* */ /* ************************** */
CBL, /**/ CBR, &C20, &c21, /**/ &C22,
1, 1, FLA_TL );
/*------------------------------------------------------------*/
/* c01 = c01 + A0 * b1t' */
FLA_Gemvc_external( FLA_NO_TRANSPOSE, FLA_CONJUGATE, alpha, A0, b1t, FLA_ONE, c01 );
/* c12t = c12t + b1t * A2' */
FLA_Gemv_external( FLA_CONJ_NO_TRANSPOSE, alpha, A2, b1t, FLA_ONE, c12t );
/* gamma11 = gamma11 + a1t * b1t' + b1t * a1t' */
FLA_Dot2cs_external( FLA_CONJUGATE, alpha, a1t, b1t, FLA_ONE, gamma11 );
/*------------------------------------------------------------*/
FLA_Cont_with_3x1_to_2x1( &AT, A0,
/* ** */ /* ** */
a1t,
&AB, A2, FLA_BOTTOM );
FLA_Cont_with_3x1_to_2x1( &BT, B0,
/* ** */ /* ** */
b1t,
&BB, B2, FLA_BOTTOM );
FLA_Cont_with_3x3_to_2x2( &CTL, /**/ &CTR, C00, /**/ c01, C02,
/* ************** */ /* ************************ */
c10t, /**/ gamma11, c12t,
&CBL, /**/ &CBR, C20, /**/ c21, C22,
FLA_BR );
}
return FLA_SUCCESS;
}
int test_gemm( FILE* stream, param_t param, result_t *result)
{
FLA_Datatype datatype = param.datatype;
FLA_Trans transa = param.trans[0], transb = param.trans[1];
FLA_Obj A, B, C, x, y, z, w;
FLA_Obj alpha, beta;
double time, time_min = MAX_TIME_VALUE;
unsigned int i,
m = param.dims[0],
n = param.dims[1],
k = param.dims[2],
repeat = param.repeat;
int is_trans, is_complex;
// Create matrices.
is_trans = (transa == FLA_NO_TRANSPOSE);
FLA_Obj_create( datatype, (is_trans ? m:k), (is_trans ? k:m), 0,0, &A );
is_trans = (transb == FLA_NO_TRANSPOSE);
FLA_Obj_create( datatype, (is_trans ? k:n), (is_trans ? n:k), 0,0, &B );
FLA_Obj_create( datatype, m, n, 0,0, &C );
FLA_Obj_create( datatype, n, 1, 0, 0, &x );
FLA_Obj_create( datatype, m, 1, 0, 0, &y );
FLA_Obj_create( datatype, m, 1, 0, 0, &z );
FLA_Obj_create( datatype, k, 1, 0, 0, &w );
// Initialize the test matrices.
FLA_Random_matrix( A );
FLA_Random_matrix( B );
FLA_Random_matrix( C );
FLA_Random_matrix( x );
FLA_Set( FLA_ZERO, y );
FLA_Set( FLA_ZERO, w );
FLA_Set( FLA_ZERO, z );
// Constants.
alpha = FLA_MINUS_ONE;
beta = FLA_ZERO;
// Repeat the experiment repeat times and record results.
for ( i = 0; i < repeat; ++i )
{
time = FLA_Clock();
FLA_Gemm_external( transa, transb, alpha, A, B, beta, C );
time = FLA_Clock() - time;
time_min = min( time_min, time );
}
is_complex = FLA_Obj_is_complex( C );
result->performance = ( FMULS * FP_PER_MUL(is_complex) +
FADDS * FP_PER_ADD(is_complex) )/time_min/FLOPS_PER_UNIT_PERF;
FLA_Gemv_external( FLA_NO_TRANSPOSE, FLA_ONE, C, x, FLA_ZERO, y );
FLA_Gemv_external( transb, FLA_ONE, B, x, FLA_ZERO, w );
FLA_Gemv_external( transa, alpha, A, w, FLA_ZERO, z );
result->residual = FLA_Max_elemwise_diff( y, z );
FLA_Obj_free( &A );
FLA_Obj_free( &B );
FLA_Obj_free( &C );
FLA_Obj_free( &x );
FLA_Obj_free( &y );
FLA_Obj_free( &z );
FLA_Obj_free( &w );
return 0;
}
void time_QR_UT(
int variant, int type, int nrepeats, int m, int n,
FLA_Obj A, FLA_Obj A_ref, FLA_Obj t, FLA_Obj T, FLA_Obj W, FLA_Obj b, FLA_Obj b_orig,
double *dtime, double *diff, double *gflops )
{
int
irep;
double
dtime_old = 1.0e9;
FLA_Obj
A_save, b_save, norm;
FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, A, &A_save );
FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, b, &b_save );
if ( FLA_Obj_is_single_precision( A ) )
FLA_Obj_create( FLA_FLOAT, 1, 1, 0, 0, &norm );
else
FLA_Obj_create( FLA_DOUBLE, 1, 1, 0, 0, &norm );
FLA_Copy_external( A, A_save );
FLA_Copy_external( b, b_save );
for ( irep = 0 ; irep < nrepeats; irep++ ){
FLA_Copy_external( A_save, A );
*dtime = FLA_Clock();
switch( variant ){
case 0:{
switch( type ){
case FLA_ALG_REFERENCE:
REF_QR_UT( A, t );
break;
case FLA_ALG_FRONT:
FLA_QR_UT( A, T );
break;
default:
printf("trouble\n");
}
break;
}
}
*dtime = FLA_Clock() - *dtime;
dtime_old = min( *dtime, dtime_old );
}
if ( type == FLA_ALG_REFERENCE )
{
FLA_Obj AT, AB;
FLA_Obj bT, bB;
FLA_Obj y;
FLA_Obj_create( FLA_Obj_datatype( b ), n, 1, 0, 0, &y );
FLA_Copy_external( b, b_orig );
if ( FLA_Obj_is_real( A ) )
FLA_Apply_Q_blk_external( FLA_LEFT, FLA_TRANSPOSE, FLA_COLUMNWISE, A, t, b );
else
FLA_Apply_Q_blk_external( FLA_LEFT, FLA_CONJ_TRANSPOSE, FLA_COLUMNWISE, A, t, b );
FLA_Part_2x1( A, &AT,
&AB, FLA_Obj_width( A ), FLA_TOP );
FLA_Part_2x1( b, &bT,
&bB, FLA_Obj_width( A ), FLA_TOP );
FLA_Trsm_external( FLA_LEFT, FLA_UPPER_TRIANGULAR, FLA_NO_TRANSPOSE,
FLA_NONUNIT_DIAG, FLA_ONE, AT, bT );
FLA_Gemv_external( FLA_NO_TRANSPOSE, FLA_MINUS_ONE, A_save, bT, FLA_ONE, b_orig );
FLA_Gemv_external( FLA_CONJ_TRANSPOSE, FLA_ONE, A_save, b_orig, FLA_ZERO, y );
FLA_Nrm2_external( y, norm );
FLA_Obj_extract_real_scalar( norm, diff );
FLA_Obj_free( &y );
}
else
{
FLA_Obj x, y;
FLA_Obj_create( FLA_Obj_datatype( b ), n, 1, 0, 0, &y );
FLA_Obj_create( FLA_Obj_datatype( b ), n, 1, 0, 0, &x );
FLA_Copy_external( b, b_orig );
FLA_QR_UT_solve( A, T, b, x );
FLA_Gemv_external( FLA_NO_TRANSPOSE, FLA_MINUS_ONE, A_save, x, FLA_ONE, b_orig );
FLA_Gemv_external( FLA_CONJ_TRANSPOSE, FLA_ONE, A_save, b_orig, FLA_ZERO, y );
FLA_Nrm2_external( y, norm );
FLA_Obj_extract_real_scalar( norm, diff );
FLA_Obj_free( &x );
FLA_Obj_free( &y );
}
*gflops = ( 2.0 * m * n * n -
( 2.0 / 3.0 ) * n * n * n ) /
dtime_old / 1e9;
if ( FLA_Obj_is_complex( A ) )
*gflops *= 4.0;
*dtime = dtime_old;
FLA_Copy_external( A_save, A );
FLA_Copy_external( b_save, b );
FLA_Obj_free( &A_save );
FLA_Obj_free( &b_save );
FLA_Obj_free( &norm );
}
FLA_Error FLA_Syr2k_ln_unb_var4( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C )
{
FLA_Obj AT, A0,
AB, a1t,
A2;
FLA_Obj BT, B0,
BB, b1t,
B2;
FLA_Obj CTL, CTR, C00, c01, C02,
CBL, CBR, c10t, gamma11, c12t,
C20, c21, C22;
FLA_Scalr_external( FLA_LOWER_TRIANGULAR, beta, C );
FLA_Part_2x1( A, &AT,
&AB, 0, FLA_TOP );
FLA_Part_2x1( B, &BT,
&BB, 0, FLA_TOP );
FLA_Part_2x2( C, &CTL, &CTR,
&CBL, &CBR, 0, 0, FLA_TL );
while ( FLA_Obj_length( AT ) < FLA_Obj_length( A ) ){
FLA_Repart_2x1_to_3x1( AT, &A0,
/* ** */ /* ** */
&a1t,
AB, &A2, 1, FLA_BOTTOM );
FLA_Repart_2x1_to_3x1( BT, &B0,
/* ** */ /* ** */
&b1t,
BB, &B2, 1, FLA_BOTTOM );
FLA_Repart_2x2_to_3x3( CTL, /**/ CTR, &C00, /**/ &c01, &C02,
/* ************* */ /* ************************** */
&c10t, /**/ &gamma11, &c12t,
CBL, /**/ CBR, &C20, /**/ &c21, &C22,
1, 1, FLA_BR );
/*------------------------------------------------------------*/
/* c21 = c21 + A2 * b1t' */
FLA_Gemv_external( FLA_NO_TRANSPOSE, alpha, A2, b1t, FLA_ONE, c21 );
/* c21 = c21 + B2 * a1t' */
FLA_Gemv_external( FLA_NO_TRANSPOSE, alpha, B2, a1t, FLA_ONE, c21 );
/* gamma11 = gamma11 + a1t * b1t' + b1t * a1t' */
FLA_Dot2s_external( alpha, a1t, b1t, FLA_ONE, gamma11 );
/*------------------------------------------------------------*/
FLA_Cont_with_3x1_to_2x1( &AT, A0,
a1t,
/* ** */ /* ** */
&AB, A2, FLA_TOP );
FLA_Cont_with_3x1_to_2x1( &BT, B0,
b1t,
/* ** */ /* ** */
&BB, B2, FLA_TOP );
FLA_Cont_with_3x3_to_2x2( &CTL, /**/ &CTR, C00, c01, /**/ C02,
c10t, gamma11, /**/ c12t,
/* ************** */ /* ************************ */
&CBL, /**/ &CBR, C20, c21, /**/ C22,
FLA_TL );
}
return FLA_SUCCESS;
}
FLA_Error FLA_LU_piv_unb_var3( FLA_Obj A, FLA_Obj p )
{
FLA_Obj ATL, ATR, A00, a01, A02,
ABL, ABR, a10t, alpha11, a12t,
A20, a21, A22;
FLA_Obj AL, AR, A0, a1, A2;
FLA_Obj pT, p0,
pB, pi1,
p2;
FLA_Obj AB0, aB1;
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, 0, 0, FLA_TL );
FLA_Part_1x2( A, &AL, &AR, 0, FLA_LEFT );
FLA_Part_2x1( p, &pT,
&pB, 0, FLA_TOP );
while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) &&
FLA_Obj_width( ATL ) < FLA_Obj_width( A )){
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &a01, &A02,
/* ************* */ /* ************************** */
&a10t, /**/ &alpha11, &a12t,
ABL, /**/ ABR, &A20, /**/ &a21, &A22,
1, 1, FLA_BR );
FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, /**/ &a1, &A2,
1, FLA_RIGHT );
FLA_Repart_2x1_to_3x1( pT, &p0,
/* ** */ /* *** */
&pi1,
pB, &p2, 1, FLA_BOTTOM );
/*------------------------------------------------------------*/
// Apply previously computed pivots
FLA_Apply_pivots( FLA_LEFT, FLA_NO_TRANSPOSE, p0, a1 );
// a01 = trilu( A00 ) \ a01
FLA_Trsv_external( FLA_LOWER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_UNIT_DIAG, A00, a01 );
// alpha11 = alpha11 - a10t * a01
FLA_Dots_external( FLA_MINUS_ONE, a10t, a01, FLA_ONE, alpha11 );
// a21 = a21 - A20 * a01
FLA_Gemv_external( FLA_NO_TRANSPOSE, FLA_MINUS_ONE, A20, a01, FLA_ONE, a21 );
// aB1 = / alpha11 \
// \ a21 /
FLA_Merge_2x1( alpha11,
a21, &aB1 );
// Determine pivot index
FLA_Amax_external( aB1, pi1 );
// Apply pivots to current column
FLA_Apply_pivots( FLA_LEFT, FLA_NO_TRANSPOSE, pi1, aB1 );
// a21 = a21 / alpha11
FLA_Inv_scal_external( alpha11, a21 );
// AB0 = / a10t \
// \ A20 /
FLA_Merge_2x1( a10t,
A20, &AB0 );
// Apply pivots to previous columns
FLA_Apply_pivots( FLA_LEFT, FLA_NO_TRANSPOSE, pi1, AB0 );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, a01, /**/ A02,
a10t, alpha11, /**/ a12t,
/* ************** */ /* ************************ */
&ABL, /**/ &ABR, A20, a21, /**/ A22,
FLA_TL );
FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, a1, /**/ A2,
FLA_LEFT );
FLA_Cont_with_3x1_to_2x1( &pT, p0,
pi1,
/* ** */ /* *** */
&pB, p2, FLA_TOP );
}
if ( FLA_Obj_width( ATR ) > 0 )
{
/* Apply pivots to untouched columns */
FLA_Apply_pivots( FLA_LEFT, FLA_NO_TRANSPOSE, p, ATR );
/* ATR = trilu( ATL ) \ ATR */
FLA_Trsm_external( FLA_LEFT, FLA_LOWER_TRIANGULAR,
FLA_NO_TRANSPOSE, FLA_UNIT_DIAG,
FLA_ONE, ATL, ATR );
}
return FLA_SUCCESS;
}
int main( int argc, char** argv ) {
FLA_Datatype datatype = TESTTYPE;
FLA_Obj A, Ak, T, Tk, D, Dk, A_copy, A_recovered, L, Q, Qk, W, x, y, z;
dim_t m, n, k;
dim_t min_m_n;
FLA_Error init_result;
double residual_A, residual_Axy;
int use_form_q = 1;
if ( argc == 4 ) {
m = atoi(argv[1]);
n = atoi(argv[2]);
k = atoi(argv[3]);
min_m_n = min(m,n);
} else {
fprintf(stderr, " \n");
fprintf(stderr, "Usage: %s m n k\n", argv[0]);
fprintf(stderr, " m : matrix length\n");
fprintf(stderr, " n : matrix width\n");
fprintf(stderr, " k : number of house holder vectors applied for testing\n");
fprintf(stderr, " \n");
return -1;
}
if ( m == 0 || n == 0 )
return 0;
FLA_Init_safe( &init_result );
// FLAME LQ^H setup
FLA_Obj_create( datatype, m, n, 0, 0, &A );
FLA_LQ_UT_create_T( A, &T );
// Rand A and create A_copy.
FLA_Random_matrix( A );
FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, A, &A_copy );
FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, A, &A_recovered );
FLA_Copy( A, A_copy );
// LQ test ( A = L Q^H )
FLA_LQ_UT( A, T );
// Create Q (identity), L (A_copy)
FLA_Obj_create( datatype, m, n, 0, 0, &Q ); FLA_Set_to_identity( Q );
FLA_Obj_create( datatype, m, m, 0, 0, &D );
FLA_Obj_create( datatype, k, n, 0, 0, &Qk ); FLA_Set_to_identity( Qk );
FLA_Obj_create( datatype, k, k, 0, 0, &Dk );
FLA_Obj_create( datatype, m, m, 0, 0, &L );
// Q^H := I H_{0}^H ... H_{k-1}^H
if ( use_form_q ) {
FLA_LQ_UT_form_Q( A, T, Q );
} else {
FLA_Apply_Q_UT_create_workspace_side( FLA_RIGHT, T, Q, &W );
FLA_Apply_Q_UT( FLA_RIGHT, FLA_CONJ_TRANSPOSE, FLA_FORWARD, FLA_ROWWISE,
A, T, W, Q );
FLA_Obj_free( &W );
}
// D := Q^T Q
FLA_Gemm_external( FLA_NO_TRANSPOSE, FLA_CONJ_TRANSPOSE,
FLA_ONE, Q, Q, FLA_ZERO, D );
// Qk := I H0 ... Hk
FLA_Part_1x2( T, &Tk, &W, k, FLA_LEFT );
FLA_Part_2x1( A, &Ak, &W, k, FLA_TOP );
if ( use_form_q ) {
// Overwrite the result to test FLAME API
FLA_Set( FLA_ZERO, Qk );
FLA_Copy( Ak, Qk );
FLA_LQ_UT_form_Q( Ak, Tk, Qk );
} else {
FLA_Apply_Q_UT_create_workspace( Tk, Qk, &W );
FLA_Apply_Q_UT( FLA_LEFT, FLA_NO_TRANSPOSE, FLA_FORWARD, FLA_ROWWISE,
Ak, Tk, W, Qk );
FLA_Obj_free( &W );
}
// Dk := Qk^T Qk
FLA_Gemm_external( FLA_NO_TRANSPOSE, FLA_CONJ_TRANSPOSE,
FLA_ONE, Qk, Qk, FLA_ZERO, Dk );
// L := A (Q^H)^H
if ( use_form_q ) {
// Note that the formed Q is actually Q^H; transb should be carefully assigned.
FLA_Gemm_external( FLA_NO_TRANSPOSE, FLA_CONJ_TRANSPOSE,
FLA_ONE, A_copy, Q, FLA_ZERO, L );
} else {
FLA_Apply_Q_UT_create_workspace( T, L, &W );
FLA_Apply_Q_UT( FLA_RIGHT, FLA_NO_TRANSPOSE, FLA_FORWARD, FLA_ROWWISE,
A, T, W, L );
FLA_Obj_free( &W );
}
FLA_Gemm_external( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_ONE, L, Q, FLA_ZERO, A_recovered );
// Create vectors for testing
FLA_Obj_create( datatype, n, 1, 0, 0, &x ); FLA_Set( FLA_ZERO, x );
FLA_Obj_create( datatype, m, 1, 0, 0, &y ); FLA_Set( FLA_ZERO, y );
FLA_Obj_create( datatype, m, 1, 0, 0, &z ); FLA_Set( FLA_ZERO, z );
// x is given
FLA_Set( FLA_ONE, x );
// y := Ax
FLA_Gemv_external( FLA_NO_TRANSPOSE, FLA_ONE, A_copy, x, FLA_ZERO, y );
// z := L (Q^H) x , libflame
FLA_Apply_Q_UT_create_workspace( T, x, &W );
FLA_Apply_Q_UT( FLA_LEFT, FLA_CONJ_TRANSPOSE, FLA_FORWARD, FLA_ROWWISE,
A, T, W, x );
FLA_Obj_free( &W );
if ( m < n )
FLA_Part_2x1( x, &x, &W, m, FLA_TOP );
else
FLA_Part_1x2( L, &L, &W, n, FLA_LEFT );
FLA_Gemv_external( FLA_NO_TRANSPOSE, FLA_ONE, L, x, FLA_ZERO, z );
// Comapre (A_copy, A_recovered), (y,z) and (y,w)
residual_A = FLA_Max_elemwise_diff( A_copy, A_recovered );
residual_Axy = FLA_Max_elemwise_diff( y, z );
if ( 1 || residual_A > EPS || residual_Axy > EPS ) {
FLA_Obj_fshow( stdout, " - Given - ", A_copy, "% 6.4e", "------");
FLA_Obj_fshow( stdout, " - Factor - ", A, "% 6.4e", "------");
FLA_Obj_fshow( stdout, " - T - ", T, "% 6.4e", "------");
FLA_Obj_fshow( stdout, " - Q - ", Q, "% 6.4e", "------");
FLA_Obj_fshow( stdout, " - D = Q^T Q - ", D, "% 6.4e", "------");
FLA_Obj_fshow( stdout, " - Qk - ", Qk, "% 6.4e", "------");
FLA_Obj_fshow( stdout, " - Dk = Qk^T Qk - ", Dk, "% 6.4e", "------");
FLA_Obj_fshow( stdout, " - L - ", L, "% 6.4e", "------");
FLA_Obj_fshow( stdout, " - Recovered A - ", A_recovered, "% 6.4e", "------");
fprintf( stdout, "lapack2flame: %lu x %lu, %lu: ", m, n, k);
fprintf( stdout, "| A - A_recovered | = %12.10e, | Ax - y | = %12.10e\n\n",
residual_A, residual_Axy ) ;
}
FLA_Obj_free( &A );
FLA_Obj_free( &T );
FLA_Obj_free( &A_copy );
FLA_Obj_free( &A_recovered );
FLA_Obj_free( &L );
FLA_Obj_free( &Q );
FLA_Obj_free( &Qk );
FLA_Obj_free( &D );
FLA_Obj_free( &Dk );
FLA_Obj_free( &x );
FLA_Obj_free( &y );
FLA_Obj_free( &z );
FLA_Finalize_safe( init_result );
}
void time_LQ_UT(
int param_combo, int type, int nrepeats, int m, int n, int b_flash,
FLA_Obj A, FLA_Obj TW, FLA_Obj b, FLA_Obj x,
double *dtime, double *diff, double *gflops )
{
int
irep;
double
dtime_old = 1.0e9;
FLA_Obj A_save;
FLASH_Obj_create_copy_of( FLA_NO_TRANSPOSE, A, &A_save );
for ( irep = 0 ; irep < nrepeats; irep++ )
{
FLASH_Copy( A_save, A );
*dtime = FLA_Clock();
switch( param_combo ){
// Time parameter combination 0
case 0:{
switch( type ){
case FLA_ALG_FRONT:
FLASH_LQ_UT( A, TW );
break;
default:
printf("trouble\n");
}
break;
}
}
*dtime = FLA_Clock() - *dtime;
dtime_old = min( *dtime, dtime_old );
}
{
FLA_Obj A_save_flat, x_flat, b_flat, y_flat;
FLA_Obj norm;
FLASH_Obj_create_flat_copy_of_hier( A_save, &A_save_flat );
FLASH_Obj_create_flat_copy_of_hier( b, &b_flat );
FLASH_Obj_create_flat_conf_to_hier( FLA_NO_TRANSPOSE, x, &x_flat );
FLASH_Obj_create_flat_conf_to_hier( FLA_NO_TRANSPOSE, x, &y_flat );
FLA_Obj_create( FLA_Obj_datatype_proj_to_real( A ), 1, 1, 0, 0, &norm );
/*
{
FLA_Obj At, Tt;
FLASH_Obj_create_flat_copy_of_hier( A_save, &At );
FLA_Obj_create( FLA_Obj_datatype( A_save ), b_flash, FLA_Obj_min_dim( At ), 0, 0, &Tt );
FLA_LQ_UT( At, Tt );
FLASH_Obj_show( "A_save", A_save, "%9.1e", "" );
FLASH_Obj_show( "A", A, "%9.1e", "" );
FLA_Obj_show( "At", At, "%9.1e", "" );
FLA_Obj_free( &At );
FLA_Obj_free( &Tt );
}
*/
FLASH_LQ_UT_solve( A, TW, b, x );
FLASH_Obj_flatten( x, x_flat );
FLA_Gemv_external( FLA_NO_TRANSPOSE, FLA_ONE, A_save_flat, x_flat, FLA_MINUS_ONE, b_flat );
FLA_Gemv_external( FLA_CONJ_TRANSPOSE, FLA_ONE, A_save_flat, b_flat, FLA_ZERO, y_flat );
FLA_Nrm2_external( y_flat, norm );
FLA_Obj_extract_real_scalar( norm, diff );
FLA_Obj_free( &A_save_flat );
FLA_Obj_free( &b_flat );
FLA_Obj_free( &x_flat );
FLA_Obj_free( &y_flat );
FLA_Obj_free( &norm );
}
*gflops = ( 2.0 * m * n * n -
( 2.0 / 3.0 ) * n * n * n ) /
dtime_old /
1.0e9;
if ( FLA_Obj_is_complex( A ) )
*gflops *= 4.0;
*dtime = dtime_old;
FLASH_Obj_free( &A_save );
}
void time_LU(
int pivot_combo, int type, int nrepeats, int m, int n, dim_t nb_alg, dim_t nb_flash,
FLA_Obj A, FLA_Obj p, FLA_Obj x, FLA_Obj b, FLA_Obj norm,
double *dtime, double *diff, double *gflops )
{
int
irep;
double
dtime_old = 1.0e9;
FLA_Obj AH_save, b_save;
FLA_Obj AH, pH, bH, LH;
FLASH_LU_incpiv_create_hier_matrices( A, 1, &nb_flash, nb_alg,
&AH, &pH, &LH );
FLASH_Obj_create_hier_copy_of_flat( b, 1, &nb_flash, &bH );
FLASH_Obj_create_copy_of( FLA_NO_TRANSPOSE, AH, &AH_save );
FLA_Obj_create_copy_of( FLA_NO_TRANSPOSE, b, &b_save );
for ( irep = 0 ; irep < nrepeats; irep++ )
{
FLASH_Copy( AH_save, AH );
*dtime = FLA_Clock();
switch( pivot_combo ){
case 0:
{
switch( type )
{
case FLA_ALG_FRONT_OPT0:
FLASH_LU_incpiv_noopt( AH, pH, LH );
break;
case FLA_ALG_FRONT_OPT1:
FLASH_LU_incpiv_opt1( AH, pH, LH );
break;
default:
printf("trouble\n");
}
break;
}
}
*dtime = FLA_Clock() - *dtime;
dtime_old = min( *dtime, dtime_old );
}
{
FLASH_FS_incpiv( AH, pH, LH, bH );
FLASH_Trsv( FLA_UPPER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_NONUNIT_DIAG,
AH, bH );
FLASH_Obj_flatten( bH, x );
FLA_Gemv_external( FLA_NO_TRANSPOSE, FLA_ONE,
A, x, FLA_MINUS_ONE, b );
FLA_Nrm2_external( b, norm );
FLA_Obj_extract_real_scalar( norm, diff );
}
*gflops = 2.0 / 3.0 * m * m * n /
dtime_old / 1e9;
if ( FLA_Obj_is_complex( A ) ) *gflops *= 4.0;
*dtime = dtime_old;
FLA_Copy( b_save, b );
FLASH_Obj_free( &AH );
FLASH_Obj_free( &pH );
FLASH_Obj_free( &bH );
FLASH_Obj_free( &LH );
FLA_Obj_free( &b_save );
FLASH_Obj_free( &AH_save );
}
FLA_Error FLA_Symm_rl_unb_var1( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C )
{
FLA_Obj ATL, ATR, A00, a01, A02,
ABL, ABR, a10t, alpha11, a12t,
A20, a21, A22;
FLA_Obj BL, BR, B0, b1t, B2;
FLA_Obj CL, CR, C0, c1t, C2;
FLA_Scal_external( beta, C );
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, 0, 0, FLA_TL );
FLA_Part_1x2( B, &BL, &BR, 0, FLA_LEFT );
FLA_Part_1x2( C, &CL, &CR, 0, FLA_LEFT );
while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ){
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &a01, &A02,
/* ************* */ /* ************************** */
&a10t, /**/ &alpha11, &a12t,
ABL, /**/ ABR, &A20, /**/ &a21, &A22,
1, 1, FLA_BR );
FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, /**/ &b1t, &B2,
1, FLA_RIGHT );
FLA_Repart_1x2_to_1x3( CL, /**/ CR, &C0, /**/ &c1t, &C2,
1, FLA_RIGHT );
/*------------------------------------------------------------*/
/* C0 = C0 + b1t * a10t */
FLA_Ger_external( alpha, b1t, a10t, C0 );
/* c1t = c1t + B0 * a10t' */
FLA_Gemv_external( FLA_NO_TRANSPOSE, alpha, B0, a10t, FLA_ONE, c1t );
/* c1t = c1t + b1t * alpha11 */
FLA_Axpys_external( alpha, alpha11, b1t, FLA_ONE, c1t );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, a01, /**/ A02,
a10t, alpha11, /**/ a12t,
/* ************** */ /* ************************ */
&ABL, /**/ &ABR, A20, a21, /**/ A22,
FLA_TL );
FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, b1t, /**/ B2,
FLA_LEFT );
FLA_Cont_with_1x3_to_1x2( &CL, /**/ &CR, C0, c1t, /**/ C2,
FLA_LEFT );
}
return FLA_SUCCESS;
}
FLA_Error FLA_QR_UT_unb_var2( FLA_Obj A, FLA_Obj T )
{
FLA_Obj ATL, ATR, A00, a01, A02,
ABL, ABR, a10t, alpha11, a12t,
A20, a21, A22;
FLA_Obj TTL, TTR, T00, t01, T02,
TBL, TBR, t10t, tau11, t12t,
T20, t21, T22;
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, 0, 0, FLA_TL );
FLA_Part_2x2( T, &TTL, &TTR,
&TBL, &TBR, 0, 0, FLA_TL );
while ( FLA_Obj_min_dim( ABR ) > 0 ){
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &a01, &A02,
/* ************* */ /* ************************** */
&a10t, /**/ &alpha11, &a12t,
ABL, /**/ ABR, &A20, /**/ &a21, &A22,
1, 1, FLA_BR );
FLA_Repart_2x2_to_3x3( TTL, /**/ TTR, &T00, /**/ &t01, &T02,
/* ************* */ /* ************************ */
&t10t, /**/ &tau11, &t12t,
TBL, /**/ TBR, &T20, /**/ &t21, &T22,
1, 1, FLA_BR );
/*------------------------------------------------------------*/
// Compute tau11 and u21 from alpha11 and a21 such that tau11 and u21
// determine a Householder transform H such that applying H from the
// left to the column vector consisting of alpha11 and a21 annihilates
// the entries in a21 (and updates alpha11).
FLA_Househ2_UT( FLA_LEFT,
alpha11,
a21, tau11 );
// / a12t \ = H / a12t \
// \ A22 / \ A22 /
//
// where H is formed from tau11 and u21.
FLA_Apply_H2_UT( FLA_LEFT, tau11, a21, a12t,
A22 );
// t01 = a10t' + A20' * u21;
FLA_Copyt_external( FLA_CONJ_TRANSPOSE, a10t, t01 );
FLA_Gemv_external( FLA_CONJ_TRANSPOSE, FLA_ONE, A20, a21, FLA_ONE, t01 );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, a01, /**/ A02,
a10t, alpha11, /**/ a12t,
/* ************** */ /* ************************ */
&ABL, /**/ &ABR, A20, a21, /**/ A22,
FLA_TL );
FLA_Cont_with_3x3_to_2x2( &TTL, /**/ &TTR, T00, t01, /**/ T02,
t10t, tau11, /**/ t12t,
/* ************** */ /* ********************** */
&TBL, /**/ &TBR, T20, t21, /**/ T22,
FLA_TL );
}
return FLA_SUCCESS;
}
