void libfla_test_qrut_impl( int impl,
FLA_Obj A,
FLA_Obj T )
{
switch ( impl )
{
case FLA_TEST_HIER_FRONT_END:
FLASH_QR_UT( A, T );
break;
case FLA_TEST_FLAT_FRONT_END:
FLA_QR_UT( A, T );
break;
case FLA_TEST_FLAT_UNB_VAR:
FLA_QR_UT_internal( A, T, qrut_cntl_unb );
break;
case FLA_TEST_FLAT_OPT_VAR:
FLA_QR_UT_internal( A, T, qrut_cntl_opt );
break;
case FLA_TEST_FLAT_BLK_VAR:
FLA_QR_UT_internal( A, T, qrut_cntl_blk );
break;
default:
libfla_test_output_error( "Invalid implementation type.\n" );
}
}
FLA_Error FLA_Svd_uv_unb_var1( dim_t n_iter_max, FLA_Obj A, FLA_Obj s, FLA_Obj U, FLA_Obj V, dim_t k_accum, dim_t b_alg )
{
FLA_Error r_val = FLA_SUCCESS;
FLA_Datatype dt;
FLA_Datatype dt_real;
FLA_Datatype dt_comp;
FLA_Obj scale, T, S, rL, rR, d, e, G, H;
dim_t m_A, n_A;
dim_t min_m_n;
dim_t n_GH;
double crossover_ratio = 17.0 / 9.0;
n_GH = k_accum;
m_A = FLA_Obj_length( A );
n_A = FLA_Obj_width( A );
min_m_n = FLA_Obj_min_dim( A );
dt = FLA_Obj_datatype( A );
dt_real = FLA_Obj_datatype_proj_to_real( A );
dt_comp = FLA_Obj_datatype_proj_to_complex( A );
// Create matrices to hold block Householder transformations.
FLA_Bidiag_UT_create_T( A, &T, &S );
// Create vectors to hold the realifying scalars.
FLA_Obj_create( dt, min_m_n, 1, 0, 0, &rL );
FLA_Obj_create( dt, min_m_n, 1, 0, 0, &rR );
// Create vectors to hold the diagonal and sub-diagonal.
FLA_Obj_create( dt_real, min_m_n, 1, 0, 0, &d );
FLA_Obj_create( dt_real, min_m_n-1, 1, 0, 0, &e );
// Create matrices to hold the left and right Givens scalars.
FLA_Obj_create( dt_comp, min_m_n-1, n_GH, 0, 0, &G );
FLA_Obj_create( dt_comp, min_m_n-1, n_GH, 0, 0, &H );
// Create a real scaling factor.
FLA_Obj_create( dt_real, 1, 1, 0, 0, &scale );
// Compute a scaling factor; If none is needed, sigma will be set to one.
FLA_Svd_compute_scaling( A, scale );
// Scale the matrix if scale is non-unit.
if ( !FLA_Obj_equals( scale, FLA_ONE ) )
FLA_Scal( scale, A );
if ( m_A < crossover_ratio * n_A )
{
// Reduce the matrix to bidiagonal form.
// Apply scalars to rotate elements on the superdiagonal to the real domain.
// Extract the diagonal and superdiagonal from A.
FLA_Bidiag_UT( A, T, S );
FLA_Bidiag_UT_realify( A, rL, rR );
FLA_Bidiag_UT_extract_real_diagonals( A, d, e );
// Form U and V.
FLA_Bidiag_UT_form_U( A, T, U );
FLA_Bidiag_UT_form_V( A, S, V );
// Apply the realifying scalars in rL and rR to U and V, respectively.
{
FLA_Obj UL, UR;
FLA_Obj VL, VR;
FLA_Part_1x2( U, &UL, &UR, min_m_n, FLA_LEFT );
FLA_Part_1x2( V, &VL, &VR, min_m_n, FLA_LEFT );
FLA_Apply_diag_matrix( FLA_RIGHT, FLA_CONJUGATE, rL, UL );
FLA_Apply_diag_matrix( FLA_RIGHT, FLA_NO_CONJUGATE, rR, VL );
}
// Perform a singular value decomposition on the bidiagonal matrix.
r_val = FLA_Bsvd_v_opt_var1( n_iter_max, d, e, G, H, U, V, b_alg );
}
else // if ( crossover_ratio * n_A <= m_A )
{
FLA_Obj TQ, R;
FLA_Obj AT,
AB;
FLA_Obj UL, UR;
// Perform a QR factorization on A and form Q in U.
FLA_QR_UT_create_T( A, &TQ );
FLA_QR_UT( A, TQ );
FLA_QR_UT_form_Q( A, TQ, U );
FLA_Obj_free( &TQ );
// Set the lower triangle of R to zero and then copy the upper
// triangle of A to R.
FLA_Part_2x1( A, &AT,
&AB, n_A, FLA_TOP );
FLA_Obj_create( dt, n_A, n_A, 0, 0, &R );
FLA_Setr( FLA_LOWER_TRIANGULAR, FLA_ZERO, R );
FLA_Copyr( FLA_UPPER_TRIANGULAR, AT, R );
// Reduce the matrix to bidiagonal form.
// Apply scalars to rotate elements on the superdiagonal to the real domain.
// Extract the diagonal and superdiagonal from A.
FLA_Bidiag_UT( R, T, S );
FLA_Bidiag_UT_realify( R, rL, rR );
FLA_Bidiag_UT_extract_real_diagonals( R, d, e );
// Form V from right Householder vectors in upper triangle of R.
FLA_Bidiag_UT_form_V( R, S, V );
// Form U in R.
FLA_Bidiag_UT_form_U( R, T, R );
// Apply the realifying scalars in rL and rR to U and V, respectively.
FLA_Apply_diag_matrix( FLA_RIGHT, FLA_CONJUGATE, rL, R );
FLA_Apply_diag_matrix( FLA_RIGHT, FLA_NO_CONJUGATE, rR, V );
// Perform a singular value decomposition on the bidiagonal matrix.
r_val = FLA_Bsvd_v_opt_var1( n_iter_max, d, e, G, H, R, V, b_alg );
// Multiply R into U, storing the result in A and then copying back
// to U.
FLA_Part_1x2( U, &UL, &UR, n_A, FLA_LEFT );
FLA_Gemm( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_ONE, UL, R, FLA_ZERO, A );
FLA_Copy( A, UL );
FLA_Obj_free( &R );
}
// Copy the converged eigenvalues to the output vector.
FLA_Copy( d, s );
// Sort the singular values and singular vectors in descending order.
FLA_Sort_svd( FLA_BACKWARD, s, U, V );
// If the matrix was scaled, rescale the singular values.
if ( !FLA_Obj_equals( scale, FLA_ONE ) )
FLA_Inv_scal( scale, s );
FLA_Obj_free( &scale );
FLA_Obj_free( &T );
FLA_Obj_free( &S );
FLA_Obj_free( &rL );
FLA_Obj_free( &rR );
FLA_Obj_free( &d );
FLA_Obj_free( &e );
FLA_Obj_free( &G );
FLA_Obj_free( &H );
return r_val;
}
FLA_Error FLA_Svd_uv_var2_components( dim_t n_iter_max, dim_t k_accum, dim_t b_alg,
FLA_Obj A, FLA_Obj s, FLA_Obj U, FLA_Obj V,
double* dtime_bred, double* dtime_bsvd, double* dtime_appq,
double* dtime_qrfa, double* dtime_gemm )
{
FLA_Error r_val = FLA_SUCCESS;
FLA_Datatype dt;
FLA_Datatype dt_real;
FLA_Datatype dt_comp;
FLA_Obj T, S, rL, rR, d, e, G, H, RG, RH, W;
dim_t m_A, n_A;
dim_t min_m_n;
dim_t n_GH;
double crossover_ratio = 17.0 / 9.0;
double dtime_temp;
n_GH = k_accum;
m_A = FLA_Obj_length( A );
n_A = FLA_Obj_width( A );
min_m_n = FLA_Obj_min_dim( A );
dt = FLA_Obj_datatype( A );
dt_real = FLA_Obj_datatype_proj_to_real( A );
dt_comp = FLA_Obj_datatype_proj_to_complex( A );
// If the matrix is a scalar, then the SVD is easy.
if ( min_m_n == 1 )
{
FLA_Copy( A, s );
FLA_Set_to_identity( U );
FLA_Set_to_identity( V );
return FLA_SUCCESS;
}
// Create matrices to hold block Householder transformations.
FLA_Bidiag_UT_create_T( A, &T, &S );
// Create vectors to hold the realifying scalars.
FLA_Obj_create( dt, min_m_n, 1, 0, 0, &rL );
FLA_Obj_create( dt, min_m_n, 1, 0, 0, &rR );
// Create vectors to hold the diagonal and sub-diagonal.
FLA_Obj_create( dt_real, min_m_n, 1, 0, 0, &d );
FLA_Obj_create( dt_real, min_m_n-1, 1, 0, 0, &e );
// Create matrices to hold the left and right Givens scalars.
FLA_Obj_create( dt_comp, min_m_n-1, n_GH, 0, 0, &G );
FLA_Obj_create( dt_comp, min_m_n-1, n_GH, 0, 0, &H );
// Create matrices to hold the left and right Givens matrices.
FLA_Obj_create( dt_real, min_m_n, min_m_n, 0, 0, &RG );
FLA_Obj_create( dt_real, min_m_n, min_m_n, 0, 0, &RH );
FLA_Obj_create( dt, m_A, n_A, 0, 0, &W );
if ( m_A >= n_A )
{
if ( m_A < crossover_ratio * n_A )
{
dtime_temp = FLA_Clock();
{
// Reduce the matrix to bidiagonal form.
// Apply scalars to rotate elements on the sub-diagonal to the real domain.
// Extract the diagonal and sub-diagonal from A.
FLA_Bidiag_UT( A, T, S );
FLA_Bidiag_UT_realify( A, rL, rR );
FLA_Bidiag_UT_extract_diagonals( A, d, e );
}
*dtime_bred = FLA_Clock() - dtime_temp;
dtime_temp = FLA_Clock();
{
// Form U and V.
FLA_Bidiag_UT_form_U( A, T, U );
FLA_Bidiag_UT_form_V( A, S, V );
}
*dtime_appq = FLA_Clock() - dtime_temp;
// Apply the realifying scalars in rL and rR to U and V, respectively.
{
FLA_Obj UL, UR;
FLA_Obj VL, VR;
FLA_Part_1x2( U, &UL, &UR, min_m_n, FLA_LEFT );
FLA_Part_1x2( V, &VL, &VR, min_m_n, FLA_LEFT );
FLA_Apply_diag_matrix( FLA_RIGHT, FLA_CONJUGATE, rL, UL );
FLA_Apply_diag_matrix( FLA_RIGHT, FLA_NO_CONJUGATE, rR, VL );
}
dtime_temp = FLA_Clock();
{
// Perform a singular value decomposition on the bidiagonal matrix.
r_val = FLA_Bsvd_v_opt_var2( n_iter_max, d, e, G, H, RG, RH, W, U, V, b_alg );
}
*dtime_bsvd = FLA_Clock() - dtime_temp;
}
else // if ( crossover_ratio * n_A <= m_A )
{
FLA_Obj TQ, R;
FLA_Obj AT,
AB;
FLA_Obj UL, UR;
//FLA_QR_UT_create_T( A, &TQ );
FLA_Obj_create( dt, 32, n_A, 0, 0, &TQ );
dtime_temp = FLA_Clock();
{
// Perform a QR factorization on A and form Q in U.
FLA_QR_UT( A, TQ );
}
*dtime_qrfa = FLA_Clock() - dtime_temp;
dtime_temp = FLA_Clock();
{
FLA_QR_UT_form_Q( A, TQ, U );
}
*dtime_appq = FLA_Clock() - dtime_temp;
FLA_Obj_free( &TQ );
// Set the lower triangle of R to zero and then copy the upper
// triangle of A to R.
FLA_Part_2x1( A, &AT,
&AB, n_A, FLA_TOP );
FLA_Obj_create( dt, n_A, n_A, 0, 0, &R );
FLA_Setr( FLA_LOWER_TRIANGULAR, FLA_ZERO, R );
FLA_Copyr( FLA_UPPER_TRIANGULAR, AT, R );
dtime_temp = FLA_Clock();
{
// Reduce the matrix to bidiagonal form.
// Apply scalars to rotate elements on the superdiagonal to the real domain.
// Extract the diagonal and superdiagonal from A.
FLA_Bidiag_UT( R, T, S );
FLA_Bidiag_UT_realify( R, rL, rR );
FLA_Bidiag_UT_extract_diagonals( R, d, e );
}
*dtime_bred = FLA_Clock() - dtime_temp;
dtime_temp = FLA_Clock();
{
// Form V from right Householder vectors in upper triangle of R.
FLA_Bidiag_UT_form_V( R, S, V );
// Form U in R.
FLA_Bidiag_UT_form_U( R, T, R );
}
*dtime_appq += FLA_Clock() - dtime_temp;
// Apply the realifying scalars in rL and rR to U and V, respectively.
FLA_Apply_diag_matrix( FLA_RIGHT, FLA_CONJUGATE, rL, R );
FLA_Apply_diag_matrix( FLA_RIGHT, FLA_NO_CONJUGATE, rR, V );
dtime_temp = FLA_Clock();
{
// Perform a singular value decomposition on the bidiagonal matrix.
r_val = FLA_Bsvd_v_opt_var2( n_iter_max, d, e, G, H, RG, RH, W, R, V, b_alg );
}
*dtime_bsvd = FLA_Clock() - dtime_temp;
dtime_temp = FLA_Clock();
{
// Multiply R into U, storing the result in A and then copying back
// to U.
FLA_Part_1x2( U, &UL, &UR, n_A, FLA_LEFT );
FLA_Gemm( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_ONE, UL, R, FLA_ZERO, A );
FLA_Copy( A, UL );
}
*dtime_gemm = FLA_Clock() - dtime_temp;
FLA_Obj_free( &R );
}
}
else // if ( m_A < n_A )
{
FLA_Check_error_code( FLA_NOT_YET_IMPLEMENTED );
}
// Copy the converged eigenvalues to the output vector.
FLA_Copy( d, s );
// Sort the singular values and singular vectors in descending order.
FLA_Sort_svd( FLA_BACKWARD, s, U, V );
FLA_Obj_free( &T );
FLA_Obj_free( &S );
FLA_Obj_free( &rL );
FLA_Obj_free( &rR );
FLA_Obj_free( &d );
FLA_Obj_free( &e );
FLA_Obj_free( &G );
FLA_Obj_free( &H );
FLA_Obj_free( &RG );
FLA_Obj_free( &RH );
FLA_Obj_free( &W );
return r_val;
}
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 );
}
int main(int argc, char *argv[])
{
int
datatype,
precision,
nb_alg, bm, bn,
m_input, n_input,
m, n,
p_first, p_last, p_inc,
p,
n_repeats,
param_combo,
i,
n_param_combos = N_PARAM_COMBOS;
char *colors = "brkgmcbrkgmcbrkgmc";
char *ticks = "o+*xso+*xso+*xso+*xs";
char m_dim_desc[14];
char n_dim_desc[14];
char m_dim_tag[10];
char n_dim_tag[10];
double max_gflops=6.0;
double
dtime,
gflops,
diff;
FLA_Obj
A, A_save, A_flat, B, B_ref, T, T_flat, W, t;
FLA_Init( );
fprintf( stdout, "%c number of repeats: ", '%' );
scanf( "%d", &n_repeats );
fprintf( stdout, "%c %d\n", '%', n_repeats );
fprintf( stdout, "%c enter FLASH blocksize: ", '%' );
scanf( "%d", &nb_alg );
fprintf( stdout, "%c %d\n", '%', nb_alg );
fprintf( stdout, "%c enter problem size first, last, inc: ", '%' );
scanf( "%d%d%d", &p_first, &p_last, &p_inc );
fprintf( stdout, "%c %d %d %d\n", '%', p_first, p_last, p_inc );
fprintf( stdout, "%c enter m n (-1 means bind to problem size): ", '%' );
scanf( "%d%d", &m_input, &n_input );
fprintf( stdout, "%c %d %d\n", '%', m_input, n_input );
fprintf( stdout, "\nclear all;\n\n" );
if ( m_input > 0 ) {
sprintf( m_dim_desc, "m = %d", m_input );
sprintf( m_dim_tag, "m%dc", m_input);
}
else if( m_input < -1 ) {
sprintf( m_dim_desc, "m = p/%d", -m_input );
sprintf( m_dim_tag, "m%dp", -m_input );
}
else if( m_input == -1 ) {
sprintf( m_dim_desc, "m = p" );
sprintf( m_dim_tag, "m%dp", 1 );
}
if ( n_input > 0 ) {
sprintf( n_dim_desc, "n = %d", n_input );
sprintf( n_dim_tag, "n%dc", n_input);
}
else if( n_input < -1 ) {
sprintf( n_dim_desc, "n = p/%d", -n_input );
sprintf( n_dim_tag, "n%dp", -n_input );
}
else if( n_input == -1 ) {
sprintf( n_dim_desc, "n = p" );
sprintf( n_dim_tag, "n%dp", 1 );
}
//precision = FLA_SINGLE_PRECISION;
precision = FLA_DOUBLE_PRECISION;
FLASH_Queue_disable();
for ( p = p_first, i = 1; p <= p_last; p += p_inc, i += 1 )
{
m = m_input;
n = n_input;
if( m < 0 ) m = p / abs(m_input);
if( n < 0 ) n = p / abs(n_input);
for ( param_combo = 0; param_combo < n_param_combos; param_combo++ ){
// Determine datatype based on trans argument.
if ( pc_str[param_combo][1] == 'c' )
{
if ( precision == FLA_SINGLE_PRECISION )
datatype = FLA_COMPLEX;
else
datatype = FLA_DOUBLE_COMPLEX;
}
else
{
if ( precision == FLA_SINGLE_PRECISION )
datatype = FLA_FLOAT;
else
datatype = FLA_DOUBLE;
}
bm = nb_alg / 4;
bn = nb_alg;
// If multiplying Q on the left, A is m x m; ...on the right, A is n x n.
if ( pc_str[param_combo][0] == 'l' )
{
FLA_Obj_create( datatype, nb_alg, nb_alg, &A_flat );
FLASH_Obj_create( datatype, nb_alg, nb_alg, 1, &nb_alg, &A );
FLASH_Obj_create( datatype, nb_alg, nb_alg, 1, &nb_alg, &A_save );
FLA_Obj_create( datatype, bm, bn, &T_flat );
FLASH_Obj_create_ext( datatype, bm, bn, 1, &bm, &bn, &T );
FLASH_Obj_create_ext( datatype, bm, n, 1, &bm, &bn, &W );
}
else
{
FLASH_Obj_create( datatype, n, n, 1, &nb_alg, &A );
}
FLASH_Obj_create( datatype, nb_alg, n, 1, &nb_alg, &B );
FLASH_Obj_create( datatype, nb_alg, n, 1, &nb_alg, &B_ref );
FLA_Obj_create( datatype, nb_alg, 1, &t );
FLASH_Random_matrix( A );
FLASH_Random_matrix( B );
fprintf( stdout, "data_applyq_%s( %d, 1:5 ) = [ %d ", pc_str[param_combo], i, p );
fflush( stdout );
FLASH_Copy( A, A_save );
FLASH_Obj_flatten( A, A_flat );
FLA_QR_blk_external( A_flat, t );
FLASH_Obj_hierarchify( A_flat, A );
time_Apply_Q( param_combo, FLA_ALG_REFERENCE, n_repeats, m, n,
A, B, B_ref, t, T, W, &dtime, &diff, &gflops );
fprintf( stdout, "%6.3lf %6.2le ", gflops, diff );
fflush( stdout );
FLASH_Copy( A_save, A );
FLASH_Obj_flatten( A, A_flat );
FLA_QR_UT( A_flat, t, T_flat );
FLASH_Obj_hierarchify( A_flat, A );
FLASH_Obj_hierarchify( T_flat, T );
time_Apply_Q( param_combo, FLA_ALG_FRONT, n_repeats, m, n,
A, B, B_ref, t, T, W, &dtime, &diff, &gflops );
fprintf( stdout, "%6.3lf %6.2le ", gflops, diff );
fflush( stdout );
fprintf( stdout, " ]; \n" );
fflush( stdout );
FLASH_Obj_free( &A );
FLA_Obj_free( &A_flat );
FLASH_Obj_free( &B );
FLASH_Obj_free( &B_ref );
FLA_Obj_free( &t );
FLASH_Obj_free( &T );
FLA_Obj_free( &T_flat );
FLASH_Obj_free( &W );
}
fprintf( stdout, "\n" );
}
fprintf( stdout, "figure;\n" );
fprintf( stdout, "hold on;\n" );
for ( i = 0; i < n_param_combos; i++ ) {
fprintf( stdout, "plot( data_applyq_%s( :,1 ), data_applyq_%s( :, 2 ), '%c:%c' ); \n",
pc_str[i], pc_str[i], colors[ i ], ticks[ i ] );
fprintf( stdout, "plot( data_applyq_%s( :,1 ), data_applyq_%s( :, 4 ), '%c-.%c' ); \n",
pc_str[i], pc_str[i], colors[ i ], ticks[ i ] );
}
fprintf( stdout, "legend( ... \n" );
for ( i = 0; i < n_param_combos; i++ )
fprintf( stdout, "'ref\\_applyq\\_%s', 'fla\\_applyq\\_%s', ... \n", pc_str[i], pc_str[i] );
fprintf( stdout, "'Location', 'SouthEast' ); \n" );
fprintf( stdout, "xlabel( 'problem size p' );\n" );
fprintf( stdout, "ylabel( 'GFLOPS/sec.' );\n" );
fprintf( stdout, "axis( [ 0 %d 0 %.2f ] ); \n", p_last, max_gflops );
fprintf( stdout, "title( 'FLAME applyq front-end performance (%s, %s)' );\n",
m_dim_desc, n_dim_desc );
fprintf( stdout, "print -depsc applyq_front_%s_%s.eps\n", m_dim_tag, n_dim_tag );
fprintf( stdout, "hold off;\n");
fflush( stdout );
FLA_Finalize( );
return 0;
}
void libfla_test_apqut_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;
signed int n_input;
FLA_Side side;
FLA_Trans trans;
FLA_Direct direct;
FLA_Store storev;
FLA_Obj A, T, W, B, eye, norm;
FLA_Obj B_save;
FLA_Obj A_test, T_test, W_test, B_test;
// Translate parameter characters to libflame constants.
FLA_Param_map_char_to_flame_side( &pc_str[pci][0], &side );
FLA_Param_map_char_to_flame_trans( &pc_str[pci][1], &trans );
FLA_Param_map_char_to_flame_direct( &pc_str[pci][2], &direct );
FLA_Param_map_char_to_flame_storev( &pc_str[pci][3], &storev );
// We want to make sure the Apply_Q_UT routines work with rectangular
// matrices. So we use m > n when testing with column-wise storage (via
// QR factorization) and m < n when testing with row-wise storage (via
// LQ factorization).
if ( storev == FLA_COLUMNWISE )
{
m_input = -1;
n_input = -1;
//m_input = -1;
//n_input = -1;
}
else // if ( storev == FLA_ROWWISE )
{
m_input = -1;
n_input = -1;
//m_input = -1;
//n_input = -1;
}
// 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 );
libfla_test_obj_create( datatype, FLA_NO_TRANSPOSE, sc_str[1], b_alg_flat, min_m_n, &T );
if ( storev == FLA_COLUMNWISE )
libfla_test_obj_create( datatype, FLA_NO_TRANSPOSE, sc_str[2], m, m, &B );
else
libfla_test_obj_create( datatype, FLA_NO_TRANSPOSE, sc_str[2], n, n, &B );
FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, B, &eye );
FLA_Apply_Q_UT_create_workspace( T, B, &W );
// 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 );
// Initialize the test matrices.
FLA_Random_matrix( A );
FLA_Set_to_identity( B );
FLA_Set_to_identity( eye );
// Save the original object contents in a temporary object.
FLA_Obj_create_copy_of( FLA_NO_TRANSPOSE, B, &B_save );
// Use hierarchical matrices if we're testing the FLASH front-end.
if ( impl == FLA_TEST_HIER_FRONT_END )
{
if ( storev == FLA_COLUMNWISE )
FLASH_QR_UT_create_hier_matrices( A, 1, &b_flash, &A_test, &T_test );
else // if ( storev == FLA_ROWWISE )
FLASH_LQ_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_Apply_Q_UT_create_workspace( T_test, B_test, &W_test );
}
else // if ( impl == FLA_TEST_FLAT_FRONT_END )
{
A_test = A;
T_test = T;
W_test = W;
B_test = B;
}
// Compute a Householder factorization.
if ( impl == FLA_TEST_HIER_FRONT_END )
{
if ( storev == FLA_COLUMNWISE ) FLASH_QR_UT( A_test, T_test );
else FLASH_LQ_UT( A_test, T_test );
}
else // if ( impl == FLA_TEST_FLAT_FRONT_END )
{
if ( storev == FLA_COLUMNWISE ) FLA_QR_UT( A_test, T_test );
else FLA_LQ_UT( A_test, T_test );
}
// 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( B_save, B_test );
else
FLA_Copy_external( B_save, B_test );
time = FLA_Clock();
libfla_test_apqut_impl( impl, side, trans, direct, storev,
A_test, T_test, W_test, B_test );
time = FLA_Clock() - time;
time_min = min( time_min, time );
}
// Multiply by its conjugate-transpose to get what should be (near) identity
// and then subtract from actual identity to get what should be (near) zero.
if ( impl == FLA_TEST_HIER_FRONT_END )
{
FLASH_Obj_flatten( B_test, B );
FLA_Gemm_external( FLA_NO_TRANSPOSE, FLA_CONJ_TRANSPOSE,
FLA_ONE, B, B, FLA_MINUS_ONE, eye );
}
else // if ( impl == FLA_TEST_FLAT_FRONT_END )
{
FLA_Gemm_external( FLA_NO_TRANSPOSE, FLA_CONJ_TRANSPOSE,
FLA_ONE, B, B, FLA_MINUS_ONE, eye );
}
// 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( &W_test );
FLASH_Obj_free( &B_test );
}
// Compute the norm of eye, which contains I - Q * Q'.
FLA_Norm1( eye, norm );
FLA_Obj_extract_real_scalar( norm, residual );
// Compute the performance of the best experiment repeat.
*perf = ( 4.0 * m * min_m_n * n -
2.0 * min_m_n * min_m_n * n ) / time_min / FLOPS_PER_UNIT_PERF;
if ( FLA_Obj_is_complex( A ) ) *perf *= 4.0;
// Free the supporting flat objects.
FLA_Obj_free( &B_save );
// Free the flat test matrices.
FLA_Obj_free( &A );
FLA_Obj_free( &T );
FLA_Obj_free( &W );
FLA_Obj_free( &B );
FLA_Obj_free( &eye );
FLA_Obj_free( &norm );
}
int main(int argc, char *argv[])
{
int
m_input,
m,
p_first, p_last, p_inc,
p,
b_alg,
variant,
n_repeats,
i,
datatype,
n_variants = 1;
char *colors = "brkgmcbrkg";
char *ticks = "o+*xso+*xs";
char m_dim_desc[14];
char m_dim_tag[10];
double max_gflops=6.0;
double safemin;
double
dtime,
gflops,
diff;
FLA_Obj
A, l, Q, T, W;
FLA_Init();
fprintf( stdout, "%c number of repeats:", '%' );
scanf( "%d", &n_repeats );
fprintf( stdout, "%c %d\n", '%', n_repeats );
fprintf( stdout, "%c Enter blocking size:", '%' );
scanf( "%d", &b_alg );
fprintf( stdout, "%c %d\n", '%', b_alg );
fprintf( stdout, "%c enter problem size first, last, inc:", '%' );
scanf( "%d%d%d", &p_first, &p_last, &p_inc );
fprintf( stdout, "%c %d %d %d\n", '%', p_first, p_last, p_inc );
fprintf( stdout, "%c enter m (-1 means bind to problem size): ", '%' );
scanf( "%d", &m_input );
fprintf( stdout, "%c %d\n", '%', m_input );
fprintf( stdout, "\n" );
if ( m_input > 0 ) {
sprintf( m_dim_desc, "m = %d", m_input );
sprintf( m_dim_tag, "m%dc", m_input);
}
else if( m_input < -1 ) {
sprintf( m_dim_desc, "m = p/%d", -m_input );
sprintf( m_dim_tag, "m%dp", -m_input );
}
else if( m_input == -1 ) {
sprintf( m_dim_desc, "m = p" );
sprintf( m_dim_tag, "m%dp", 1 );
}
/*
char ch = 's';
safemin = dlamch_( &ch );
printf( "safemin = %23.15e\n", safemin );
ch = 'e';
double eps = dlamch_( &ch );
printf( "eps dla = %23.15e\n", eps );
printf( "eps fla = %23.15e\n", FLA_EPSILON_D );
*/
for ( p = p_first, i = 1; p <= p_last; p += p_inc, i += 1 )
{
m = m_input;
if( m < 0 ) m = p / f2c_abs(m_input);
//datatype = FLA_FLOAT;
//datatype = FLA_DOUBLE;
//datatype = FLA_COMPLEX;
datatype = FLA_DOUBLE_COMPLEX;
FLA_Obj_create( datatype, m, m, 0, 0, &A );
FLA_Obj_create( datatype, m, m, 0, 0, &Q );
FLA_Obj_create( datatype, 32, m, 0, 0, &T );
FLA_Obj_create( datatype, 32, m, 0, 0, &W );
FLA_Obj_create( FLA_Obj_datatype_proj_to_real( A ), m, 1, 0, 0, &l );
//FLA_Random_herm_matrix( FLA_LOWER_TRIANGULAR, A );
//FLA_Random_spd_matrix( FLA_LOWER_TRIANGULAR, A );
FLA_Random_matrix( A );
FLA_Obj_set_to_identity( Q );
FLA_QR_UT( A, T );
FLA_Apply_Q_UT( FLA_LEFT, FLA_CONJ_TRANSPOSE, FLA_FORWARD, FLA_COLUMNWISE, A, T, W, Q );
fill_eigenvalues( l );
//FLA_Obj_show( "eig", l, "%9.2e ", "" );
FLA_Apply_diag_matrix( FLA_LEFT, FLA_NO_CONJUGATE, l, Q );
FLA_Apply_Q_UT( FLA_LEFT, FLA_NO_TRANSPOSE, FLA_FORWARD, FLA_COLUMNWISE, A, T, W, Q );
FLA_Triangularize( FLA_LOWER_TRIANGULAR, FLA_NONUNIT_DIAG, Q );
FLA_Copy( Q, A );
time_Hevd_ln( 0, FLA_ALG_REFERENCE, n_repeats, m, b_alg,
A, l, &dtime, &diff, &gflops );
fprintf( stdout, "data_REFs( %d, 1:2 ) = [ %d %6.3lf %6.2le ]; \n", i, p, gflops, diff );
fflush( stdout );
time_Hevd_ln( -1, FLA_ALG_REFERENCE, n_repeats, m, b_alg,
A, l, &dtime, &diff, &gflops );
fprintf( stdout, "data_REFd( %d, 1:2 ) = [ %d %6.3lf %6.2le ]; \n", i, p, gflops, diff );
fflush( stdout );
for ( variant = 1; variant <= n_variants; variant++ ){
fprintf( stdout, "data_var%d( %d, 1:9 ) = [ %d ", variant, i, p );
fflush( stdout );
time_Hevd_ln( variant, FLA_ALG_UNBLOCKED, n_repeats, m, b_alg,
A, l, &dtime, &diff, &gflops );
fprintf( stdout, "%6.3lf %6.2le ", gflops, diff );
fflush( stdout );
//time_Hevd_ln( variant, FLA_ALG_UNB_OPT, n_repeats, m, b_alg,
// A, l, &dtime, &diff, &gflops );
//fprintf( stdout, "%6.3lf %6.2le ", gflops, diff );
//fflush( stdout );
fprintf( stdout, "];\n" );
fflush( stdout );
}
fprintf( stdout, "\n" );
FLA_Obj_free( &A );
FLA_Obj_free( &T );
FLA_Obj_free( &W );
FLA_Obj_free( &Q );
FLA_Obj_free( &l );
}
/*
fprintf( stdout, "figure;\n" );
fprintf( stdout, "plot( data_REF( :,1 ), data_REF( :, 2 ), '-' ); \n" );
fprintf( stdout, "hold on;\n" );
for ( i = 1; i <= n_variants; i++ ) {
fprintf( stdout, "plot( data_var%d( :,1 ), data_var%d( :, 2 ), '%c:%c' ); \n",
i, i, colors[ i-1 ], ticks[ i-1 ] );
fprintf( stdout, "plot( data_var%d( :,1 ), data_var%d( :, 4 ), '%c-.%c' ); \n",
i, i, colors[ i-1 ], ticks[ i-1 ] );
}
fprintf( stdout, "legend( ... \n" );
fprintf( stdout, "'Reference', ... \n" );
for ( i = 1; i < n_variants; i++ )
fprintf( stdout, "'unb\\_var%d', 'blk\\_var%d', ... \n", i, i );
fprintf( stdout, "'unb\\_var%d', 'blk\\_var%d' ); \n", i, i );
fprintf( stdout, "xlabel( 'problem size p' );\n" );
fprintf( stdout, "ylabel( 'GFLOPS/sec.' );\n" );
fprintf( stdout, "axis( [ 0 %d 0 %.2f ] ); \n", p_last, max_gflops );
fprintf( stdout, "title( 'FLAME Hevd_ln performance (%s, %s)' );\n",
m_dim_desc, n_dim_desc );
fprintf( stdout, "print -depsc tridiag_%s_%s.eps\n", m_dim_tag, n_dim_tag );
fprintf( stdout, "hold off;\n");
fflush( stdout );
*/
FLA_Finalize( );
return 0;
}
int main(int argc, char *argv[])
{
int
m_input, n_input,
m, n,
p_first, p_last, p_inc,
p,
n_repeats,
param_combo,
i,
n_param_combos = N_PARAM_COMBOS;
FLA_Datatype datatype;
char *colors = "brkgmcbrkg";
char *ticks = "o+*xso+*xs";
char m_dim_desc[14];
char n_dim_desc[14];
char m_dim_tag[10];
char n_dim_tag[10];
double max_gflops=6.0;
double
dtime,
gflops,
diff;
FLA_Obj
A, A_ref, t_ref, t, T, T_ref, B, B_ref, X, X_ref, W;
FLA_Init();
fprintf( stdout, "%c number of repeats: ", '%' );
scanf( "%d", &n_repeats );
fprintf( stdout, "%c %d\n", '%', n_repeats );
fprintf( stdout, "%c enter problem size first, last, inc: ", '%' );
scanf( "%d%d%d", &p_first, &p_last, &p_inc );
fprintf( stdout, "%c %d %d %d\n", '%', p_first, p_last, p_inc );
fprintf( stdout, "%c enter m n (-1 means bind to problem size): ", '%' );
scanf( "%d%d", &m_input, &n_input );
fprintf( stdout, "%c %d %d\n", '%', m_input, n_input );
fprintf( stdout, "\nclear all;\n\n" );
if ( m_input > 0 ) {
sprintf( m_dim_desc, "m = %d", m_input );
sprintf( m_dim_tag, "m%dc", m_input);
}
else if( m_input < -1 ) {
sprintf( m_dim_desc, "m = p/%d", -m_input );
sprintf( m_dim_tag, "m%dp", -m_input );
}
else if( m_input == -1 ) {
sprintf( m_dim_desc, "m = p" );
sprintf( m_dim_tag, "m%dp", 1 );
}
if ( n_input > 0 ) {
sprintf( n_dim_desc, "n = %d", n_input );
sprintf( n_dim_tag, "n%dc", n_input);
}
else if( n_input < -1 ) {
sprintf( n_dim_desc, "n = p/%d", -n_input );
sprintf( n_dim_tag, "n%dp", -n_input );
}
else if( n_input == -1 ) {
sprintf( n_dim_desc, "n = p" );
sprintf( n_dim_tag, "n%dp", 1 );
}
//datatype = FLA_FLOAT;
//datatype = FLA_DOUBLE;
//datatype = FLA_COMPLEX;
datatype = FLA_DOUBLE_COMPLEX;
for ( p = p_first, i = 1; p <= p_last; p += p_inc, i += 1 )
{
m = m_input;
n = n_input;
if( m < 0 ) m = p / abs(m_input);
if( n < 0 ) n = p / abs(n_input);
for ( param_combo = 0; param_combo < n_param_combos; param_combo++ ){
if ( pc_str[param_combo][0] == 'l' )
{
FLA_Obj_create( datatype, m, m, 0, 0, &A );
FLA_Obj_create( datatype, m, m, 0, 0, &A_ref );
FLA_Obj_create( datatype, m, 1, 0, 0, &t );
FLA_Obj_create( datatype, m, 1, 0, 0, &t_ref );
FLA_Obj_create( datatype, m, n, 0, 0, &B );
FLA_Obj_create( datatype, m, n, 0, 0, &B_ref );
FLA_Obj_create( datatype, m, n, 0, 0, &X );
FLA_Obj_create( datatype, m, n, 0, 0, &X_ref );
}
else
{
FLA_Obj_create( datatype, n, n, 0, 0, &A );
FLA_Obj_create( datatype, n, n, 0, 0, &A_ref );
FLA_Obj_create( datatype, n, 1, 0, 0, &t );
FLA_Obj_create( datatype, n, 1, 0, 0, &t_ref );
FLA_Obj_create( datatype, m, n, 0, 0, &B );
FLA_Obj_create( datatype, m, n, 0, 0, &B_ref );
FLA_Obj_create( datatype, m, n, 0, 0, &X );
FLA_Obj_create( datatype, m, n, 0, 0, &X_ref );
}
FLA_Obj_create( datatype, 32, m, 0, 0, &T );
FLA_Obj_create( datatype, 32, n, 0, 0, &W );
/*
FLA_Obj_create( datatype, 4, m, &T );
FLA_Obj_create( datatype, 4, m, &T_ref );
FLA_Obj_create( datatype, 4, n, &W );
*/
/*
FLA_Obj_create( datatype, 2, m, &T );
FLA_Obj_create( datatype, 2, m, &T_ref );
FLA_Obj_create( datatype, 2, n, &W );
*/
FLA_Random_matrix( A );
FLA_Copy_external( A, A_ref );
//FLA_Obj_show( "A_orig:", A, "%12.4e", "" );
FLA_Random_matrix( B );
FLA_Copy_external( B, B_ref );
if ( pc_str[param_combo][2] == 'c' )
{
//FLA_QR_blk_external( A_ref, t_ref );
FLA_QR_UT( A, T );
}
else if ( pc_str[param_combo][2] == 'r' )
{
//FLA_LQ_blk_external( A_ref, t_ref );
FLA_LQ_UT( A, T );
}
fprintf( stdout, "data_applyq_%s( %d, 1:5 ) = [ %d ", pc_str[param_combo], i, p );
fflush( stdout );
time_Chol( param_combo, FLA_ALG_REFERENCE, n_repeats, m, n,
A, A_ref, T, t_ref, B, B_ref, X, X_ref, W, &dtime, &diff, &gflops );
fprintf( stdout, "%6.3lf %6.2le ", gflops, diff );
fflush( stdout );
time_Chol( param_combo, FLA_ALG_FRONT, n_repeats, m, n,
A, A_ref, T, t_ref, B, B_ref, X, X_ref, W, &dtime, &diff, &gflops );
fprintf( stdout, "%6.3lf %6.2le ", gflops, diff );
fflush( stdout );
fprintf( stdout, " ]; \n" );
fflush( stdout );
FLA_Obj_free( &A );
FLA_Obj_free( &A_ref );
FLA_Obj_free( &t );
FLA_Obj_free( &t_ref );
FLA_Obj_free( &B );
FLA_Obj_free( &B_ref );
FLA_Obj_free( &X );
FLA_Obj_free( &X_ref );
FLA_Obj_free( &T );
FLA_Obj_free( &W );
}
fprintf( stdout, "\n" );
}
/*
fprintf( stdout, "figure;\n" );
fprintf( stdout, "hold on;\n" );
for ( i = 0; i < n_param_combos; i++ ) {
fprintf( stdout, "plot( data_applyq_%s( :,1 ), data_applyq_%s( :, 2 ), '%c:%c' ); \n",
pc_str[i], pc_str[i], colors[ i ], ticks[ i ] );
fprintf( stdout, "plot( data_applyq_%s( :,1 ), data_applyq_%s( :, 4 ), '%c-.%c' ); \n",
pc_str[i], pc_str[i], colors[ i ], ticks[ i ] );
}
fprintf( stdout, "legend( ... \n" );
for ( i = 0; i < n_param_combos; i++ )
fprintf( stdout, "'ref\\_applyq\\_%s', 'fla\\_applyq\\_%s', ... \n", pc_str[i], pc_str[i] );
fprintf( stdout, "'Location', 'SouthEast' ); \n" );
fprintf( stdout, "xlabel( 'problem size p' );\n" );
fprintf( stdout, "ylabel( 'GFLOPS/sec.' );\n" );
fprintf( stdout, "axis( [ 0 %d 0 %.2f ] ); \n", p_last, max_gflops );
fprintf( stdout, "title( 'FLAME apply_q front-end performance (%s, %s)' );\n", m_dim_desc, n_dim_desc );
fprintf( stdout, "print -depsc apply_q_front_%s_%s.eps\n", m_dim_tag, n_dim_tag );
fprintf( stdout, "hold off;\n");
fflush( stdout );
*/
FLA_Finalize();
return 0;
}
FLA_Error FLA_Svd_ext_u_unb_var1( FLA_Svd_type jobu, FLA_Svd_type jobv,
dim_t n_iter_max,
FLA_Obj A, FLA_Obj s, FLA_Obj U, FLA_Obj V,
dim_t k_accum,
dim_t b_alg )
{
FLA_Error r_val = FLA_SUCCESS;
FLA_Datatype dt;
FLA_Datatype dt_real;
FLA_Datatype dt_comp;
FLA_Obj scale, T, S, rL, rR, d, e, G, H, C; // C is dummy.
dim_t m_A, n_A, min_m_n;
dim_t n_GH;
double crossover_ratio = 17.0 / 9.0;
FLA_Bool u_is_formed = FALSE,
v_is_formed = FALSE;
int apply_scale;
n_GH = k_accum;
m_A = FLA_Obj_length( A );
n_A = FLA_Obj_width( A );
min_m_n = min( m_A, n_A );
dt = FLA_Obj_datatype( A );
dt_real = FLA_Obj_datatype_proj_to_real( A );
dt_comp = FLA_Obj_datatype_proj_to_complex( A );
// Create matrices to hold block Householder transformations.
FLA_Bidiag_UT_create_T( A, &T, &S );
// Create vectors to hold the realifying scalars.
if ( FLA_Obj_is_complex( A ) )
{
FLA_Obj_create( dt, min_m_n, 1, 0, 0, &rL );
FLA_Obj_create( dt, min_m_n, 1, 0, 0, &rR );
}
// Create vectors to hold the diagonal and sub-diagonal.
FLA_Obj_create( dt_real, min_m_n, 1, 0, 0, &d );
FLA_Obj_create( dt_real, min_m_n-1, 1, 0, 0, &e );
// Create matrices to hold the left and right Givens scalars.
FLA_Obj_create( dt_comp, min_m_n-1, n_GH, 0, 0, &G );
FLA_Obj_create( dt_comp, min_m_n-1, n_GH, 0, 0, &H );
// Create a real scaling factor.
FLA_Obj_create( dt_real, 1, 1, 0, 0, &scale );
// Scale matrix A if necessary.
FLA_Max_abs_value( A, scale );
apply_scale =
( FLA_Obj_gt( scale, FLA_OVERFLOW_SQUARE_THRES ) == TRUE ) -
( FLA_Obj_lt( scale, FLA_UNDERFLOW_SQUARE_THRES ) == TRUE );
if ( apply_scale )
FLA_Scal( apply_scale > 0 ? FLA_SAFE_MIN : FLA_SAFE_INV_MIN, A );
if ( m_A < crossover_ratio * n_A )
{
// Reduce the matrix to bidiagonal form.
// Apply scalars to rotate elements on the superdiagonal to the real domain.
// Extract the diagonal and superdiagonal from A.
FLA_Bidiag_UT( A, T, S );
if ( FLA_Obj_is_complex( A ) )
FLA_Bidiag_UT_realify( A, rL, rR );
FLA_Bidiag_UT_extract_real_diagonals( A, d, e );
// Form U and V.
if ( u_is_formed == FALSE )
{
switch ( jobu )
{
case FLA_SVD_VECTORS_MIN_OVERWRITE:
if ( jobv != FLA_SVD_VECTORS_NONE )
FLA_Bidiag_UT_form_V_ext( FLA_UPPER_TRIANGULAR, A, S, FLA_NO_TRANSPOSE, V );
v_is_formed = TRUE; // For this case, V should be formed here.
U = A;
case FLA_SVD_VECTORS_ALL:
case FLA_SVD_VECTORS_MIN_COPY:
FLA_Bidiag_UT_form_U_ext( FLA_UPPER_TRIANGULAR, A, T, FLA_NO_TRANSPOSE, U );
u_is_formed = TRUE;
break;
case FLA_SVD_VECTORS_NONE:
// Do nothing
break;
}
}
if ( v_is_formed == FALSE )
{
if ( jobv == FLA_SVD_VECTORS_MIN_OVERWRITE )
{
FLA_Bidiag_UT_form_V_ext( FLA_UPPER_TRIANGULAR, A, S, FLA_CONJ_TRANSPOSE, A );
v_is_formed = TRUE; /* and */
V = A; // This V is actually V^H.
// V^H -> V
FLA_Obj_flip_base( &V );
FLA_Obj_flip_view( &V );
if ( FLA_Obj_is_complex( A ) )
FLA_Conjugate( V );
}
else if ( jobv != FLA_SVD_VECTORS_NONE )
{
FLA_Bidiag_UT_form_V_ext( FLA_UPPER_TRIANGULAR, A, S, FLA_NO_TRANSPOSE, V );
v_is_formed = TRUE;
}
}
// For complex matrices, apply realification transformation.
if ( FLA_Obj_is_complex( A ) && jobu != FLA_SVD_VECTORS_NONE )
{
FLA_Obj UL, UR;
FLA_Part_1x2( U, &UL, &UR, min_m_n, FLA_LEFT );
FLA_Apply_diag_matrix( FLA_RIGHT, FLA_CONJUGATE, rL, UL );
}
if ( FLA_Obj_is_complex( A ) && jobv != FLA_SVD_VECTORS_NONE )
{
FLA_Obj VL, VR;
FLA_Part_1x2( V, &VL, &VR, min_m_n, FLA_LEFT );
FLA_Apply_diag_matrix( FLA_RIGHT, FLA_NO_CONJUGATE, rR, VL );
}
// Perform a singular value decomposition on the upper bidiagonal matrix.
r_val = FLA_Bsvd_ext_opt_var1( n_iter_max,
d, e, G, H,
jobu, U, jobv, V,
FALSE, C, // C is not referenced
b_alg );
}
else // if ( crossover_ratio * n_A <= m_A )
{
FLA_Obj TQ, R;
FLA_Obj AT,
AB;
// Perform a QR factorization on A.
FLA_QR_UT_create_T( A, &TQ );
FLA_QR_UT( A, TQ );
// Set the lower triangle of R to zero and then copy the upper
// triangle of A to R.
FLA_Part_2x1( A, &AT,
&AB, n_A, FLA_TOP );
FLA_Obj_create( dt, n_A, n_A, 0, 0, &R );
FLA_Setr( FLA_LOWER_TRIANGULAR, FLA_ZERO, R );
FLA_Copyr( FLA_UPPER_TRIANGULAR, AT, R );
// Form U; if necessary overwrite on A.
if ( u_is_formed == FALSE )
{
switch ( jobu )
{
case FLA_SVD_VECTORS_MIN_OVERWRITE:
U = A;
case FLA_SVD_VECTORS_ALL:
case FLA_SVD_VECTORS_MIN_COPY:
FLA_QR_UT_form_Q( A, TQ, U );
u_is_formed = TRUE;
break;
case FLA_SVD_VECTORS_NONE:
// Do nothing
break;
}
}
FLA_Obj_free( &TQ );
// Reduce the matrix to bidiagonal form.
// Apply scalars to rotate elements on the superdiagonal to the real domain.
// Extract the diagonal and superdiagonal from A.
FLA_Bidiag_UT( R, T, S );
if ( FLA_Obj_is_complex( R ) )
FLA_Bidiag_UT_realify( R, rL, rR );
FLA_Bidiag_UT_extract_real_diagonals( R, d, e );
if ( v_is_formed == FALSE )
{
if ( jobv == FLA_SVD_VECTORS_MIN_OVERWRITE )
{
FLA_Bidiag_UT_form_V_ext( FLA_UPPER_TRIANGULAR, R, S, FLA_CONJ_TRANSPOSE, AT );
v_is_formed = TRUE; /* and */
V = AT; // This V is actually V^H.
// V^H -> V
FLA_Obj_flip_base( &V );
FLA_Obj_flip_view( &V );
if ( FLA_Obj_is_complex( A ) )
FLA_Conjugate( V );
}
else if ( jobv != FLA_SVD_VECTORS_NONE )
{
FLA_Bidiag_UT_form_V_ext( FLA_UPPER_TRIANGULAR, R, S, FLA_NO_TRANSPOSE, V );
v_is_formed = TRUE;
}
}
// Apply householder vectors U in R.
FLA_Bidiag_UT_form_U_ext( FLA_UPPER_TRIANGULAR, R, T, FLA_NO_TRANSPOSE, R );
// Apply the realifying scalars in rL and rR to U and V, respectively.
if ( FLA_Obj_is_complex( A ) && jobu != FLA_SVD_VECTORS_NONE )
{
FLA_Obj RL, RR;
FLA_Part_1x2( R, &RL, &RR, min_m_n, FLA_LEFT );
FLA_Apply_diag_matrix( FLA_RIGHT, FLA_CONJUGATE, rL, RL );
}
if ( FLA_Obj_is_complex( A ) && jobv != FLA_SVD_VECTORS_NONE )
{
FLA_Obj VL, VR;
FLA_Part_1x2( V, &VL, &VR, min_m_n, FLA_LEFT );
FLA_Apply_diag_matrix( FLA_RIGHT, FLA_NO_CONJUGATE, rR, VL );
}
// Perform a singular value decomposition on the bidiagonal matrix.
r_val = FLA_Bsvd_ext_opt_var1( n_iter_max,
d, e, G, H,
jobu, R, jobv, V,
FALSE, C,
b_alg );
// Multiply R into U, storing the result in A and then copying back
// to U.
if ( jobu != FLA_SVD_VECTORS_NONE )
{
FLA_Obj UL, UR;
FLA_Part_1x2( U, &UL, &UR, min_m_n, FLA_LEFT );
if ( jobu == FLA_SVD_VECTORS_MIN_OVERWRITE ||
jobv == FLA_SVD_VECTORS_MIN_OVERWRITE )
{
FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, UL, &C );
FLA_Gemm( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_ONE, UL, R, FLA_ZERO, C );
FLA_Copy( C, UL );
FLA_Obj_free( &C );
}
else
{
FLA_Gemm( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_ONE, UL, R, FLA_ZERO, A );
FLA_Copy( A, UL );
}
}
FLA_Obj_free( &R );
}
// Copy the converged eigenvalues to the output vector.
FLA_Copy( d, s );
// No sort is required as it is applied on FLA_Bsvd.
if ( apply_scale )
FLA_Scal( apply_scale < 0 ? FLA_SAFE_MIN : FLA_SAFE_INV_MIN, s );
// When V is overwritten, flip it again.
if ( jobv == FLA_SVD_VECTORS_MIN_OVERWRITE )
{
// Always apply conjugation first wrt dimensions used; then, flip base.
if ( FLA_Obj_is_complex( V ) )
FLA_Conjugate( V );
FLA_Obj_flip_base( &V );
}
FLA_Obj_free( &scale );
FLA_Obj_free( &T );
FLA_Obj_free( &S );
if ( FLA_Obj_is_complex( A ) )
{
FLA_Obj_free( &rL );
FLA_Obj_free( &rR );
}
FLA_Obj_free( &d );
FLA_Obj_free( &e );
FLA_Obj_free( &G );
FLA_Obj_free( &H );
return r_val;
}
