FLA_Error FLA_Trinv_uu_blk_var3( FLA_Obj A, fla_trinv_t* cntl )
{
FLA_Obj ATL, ATR, A00, A01, A02,
ABL, ABR, A10, A11, A12,
A20, A21, A22;
dim_t b;
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, 0, 0, FLA_TL );
while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ) {
b = FLA_Determine_blocksize( ABR, FLA_BR, FLA_Cntl_blocksize( cntl ) );
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &A01, &A02,
/* ************* */ /* ******************** */
&A10, /**/ &A11, &A12,
ABL, /**/ ABR, &A20, /**/ &A21, &A22,
b, b, FLA_BR );
/*------------------------------------------------------------*/
// A12 = -triuu( A11 ) \ A12;
FLA_Trsm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_NONUNIT_DIAG,
FLA_MINUS_ONE, A11, A12,
FLA_Cntl_sub_trsm1( cntl ) );
// A02 = A01 * A12 + A02;
FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_ONE, A01, A12, FLA_ONE, A02,
FLA_Cntl_sub_gemm( cntl ) );
// A01 = A01 / triuu( A11 );
FLA_Trsm_internal( FLA_RIGHT, FLA_UPPER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_NONUNIT_DIAG,
FLA_ONE, A11, A01,
FLA_Cntl_sub_trsm2( cntl ) );
// A11 = inv( A11 );
FLA_Trinv_internal( FLA_UPPER_TRIANGULAR, FLA_NONUNIT_DIAG, A11,
FLA_Cntl_sub_trinv( cntl ) );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, A01, /**/ A02,
A10, A11, /**/ A12,
/* ************** */ /* ****************** */
&ABL, /**/ &ABR, A20, A21, /**/ A22,
FLA_TL );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Trsm_lun_blk_var4( FLA_Diag diagA, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, fla_trsm_t* cntl )
{
FLA_Obj BL, BR, B0, B1, B2;
dim_t b;
FLA_Part_1x2( B, &BL, &BR, 0, FLA_RIGHT );
while ( FLA_Obj_width( BR ) < FLA_Obj_width( B ) ){
b = FLA_Determine_blocksize( BL, FLA_LEFT, FLA_Cntl_blocksize( cntl ) );
FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, &B1, /**/ &B2,
b, FLA_LEFT );
/*------------------------------------------------------------*/
/* B1 = triu( A ) \ B1; */
FLA_Trsm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR, FLA_NO_TRANSPOSE, diagA,
alpha, A, B1,
FLA_Cntl_sub_trsm( cntl ) );
/*------------------------------------------------------------*/
FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, /**/ B1, B2,
FLA_RIGHT );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Trsm_rln_blk_var2( FLA_Diag diagA, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, fla_trsm_t* cntl )
{
FLA_Obj ATL, ATR, A00, A01, A02,
ABL, ABR, A10, A11, A12,
A20, A21, A22;
FLA_Obj BL, BR, B0, B1, B2;
dim_t b;
FLA_Scal_internal( alpha, B,
FLA_Cntl_sub_scal( cntl ) );
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, 0, 0, FLA_BR );
FLA_Part_1x2( B, &BL, &BR, 0, FLA_RIGHT );
while ( FLA_Obj_length( ABR ) < FLA_Obj_length( A ) ){
b = FLA_Determine_blocksize( ATL, FLA_TL, FLA_Cntl_blocksize( cntl ) );
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, &A01, /**/ &A02,
&A10, &A11, /**/ &A12,
/* ************* */ /* ******************** */
ABL, /**/ ABR, &A20, &A21, /**/ &A22,
b, b, FLA_TL );
FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, &B1, /**/ &B2,
b, FLA_LEFT );
/*------------------------------------------------------------*/
/* B1 = B1 / tril( A11 ); */
FLA_Trsm_internal( FLA_RIGHT, FLA_LOWER_TRIANGULAR, FLA_NO_TRANSPOSE, diagA,
FLA_ONE, A11, B1,
FLA_Cntl_sub_trsm( cntl ) );
/* B0 = B0 - B1 * A10; */
FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_MINUS_ONE, B1, A10, FLA_ONE, B0,
FLA_Cntl_sub_gemm( cntl ) );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, /**/ A01, A02,
/* ************** */ /* ****************** */
A10, /**/ A11, A12,
&ABL, /**/ &ABR, A20, /**/ A21, A22,
FLA_BR );
FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, /**/ B1, B2,
FLA_RIGHT );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Chol_u_blk_var1( FLA_Obj A, fla_chol_t* cntl )
{
FLA_Obj ATL, ATR, A00, A01, A02,
ABL, ABR, A10, A11, A12,
A20, A21, A22;
dim_t b;
int r_val = FLA_SUCCESS;
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, 0, 0, FLA_TL );
while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ){
b = FLA_Determine_blocksize( ABR, FLA_BR, FLA_Cntl_blocksize( cntl ) );
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &A01, &A02,
/* ************* */ /* ******************** */
&A10, /**/ &A11, &A12,
ABL, /**/ ABR, &A20, /**/ &A21, &A22,
b, b, FLA_BR );
/*------------------------------------------------------------*/
// A01 = inv( triu( A00 )' ) * A01
FLA_Trsm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
FLA_CONJ_TRANSPOSE, FLA_NONUNIT_DIAG,
FLA_ONE, A00, A01,
FLA_Cntl_sub_trsm( cntl ) );
// A11 = A11 - A01' * A01
FLA_Herk_internal( FLA_UPPER_TRIANGULAR, FLA_CONJ_TRANSPOSE,
FLA_MINUS_ONE, A01, FLA_ONE, A11,
FLA_Cntl_sub_herk( cntl ) );
// A11 = chol( A11 )
r_val = FLA_Chol_internal( FLA_UPPER_TRIANGULAR, A11,
FLA_Cntl_sub_chol( cntl ) );
if ( r_val != FLA_SUCCESS )
return ( FLA_Obj_length( A00 ) + r_val );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, A01, /**/ A02,
A10, A11, /**/ A12,
/* ************** */ /* ****************** */
&ABL, /**/ &ABR, A20, A21, /**/ A22,
FLA_TL );
}
return r_val;
}
FLA_Error FLA_Trsm( FLA_Side side, FLA_Uplo uplo, FLA_Trans trans, FLA_Diag diag, FLA_Obj alpha, FLA_Obj A, FLA_Obj B )
{
FLA_Error r_val = FLA_SUCCESS;
// Check parameters.
if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
FLA_Trsm_check( side, uplo, trans, diag, alpha, A, B );
#ifdef FLA_ENABLE_BLAS3_FRONT_END_CNTL_TREES
r_val = FLA_Trsm_internal( side, uplo, trans, diag, alpha, A, B, fla_trsm_cntl_mm );
#else
r_val = FLA_Trsm_external( side, uplo, trans, diag, alpha, A, B );
#endif
return r_val;
}
FLA_Error FLASH_Trsm( FLA_Side side, FLA_Uplo uplo, FLA_Trans trans, FLA_Diag diag, FLA_Obj alpha, FLA_Obj A, FLA_Obj B )
{
FLA_Error r_val;
// Check parameters.
if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
FLA_Trsm_check( side, uplo, trans, diag, alpha, A, B );
// Begin a parallel region.
FLASH_Queue_begin();
// Enqueue tasks via a SuperMatrix-aware control tree.
r_val = FLA_Trsm_internal( side, uplo, trans, diag, alpha, A, B, flash_trsm_cntl_mm );
// End the parallel region.
FLASH_Queue_end();
return r_val;
}
FLA_Error FLA_Trsm_ruc_blk_var3( FLA_Diag diagA, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, fla_trsm_t* cntl )
{
FLA_Obj BT, B0,
BB, B1,
B2;
dim_t b;
FLA_Part_2x1( B, &BT,
&BB, 0, FLA_TOP );
while ( FLA_Obj_length( BT ) < FLA_Obj_length( B ) ) {
b = FLA_Determine_blocksize( BB, FLA_BOTTOM, FLA_Cntl_blocksize( cntl ) );
FLA_Repart_2x1_to_3x1( BT, &B0,
/* ** */ /* ** */
&B1,
BB, &B2, b, FLA_BOTTOM );
/*------------------------------------------------------------*/
/* B1 = B1 * triu( A ); */
FLA_Trsm_internal( FLA_RIGHT, FLA_UPPER_TRIANGULAR, FLA_CONJ_NO_TRANSPOSE, diagA,
alpha, A, B1,
FLA_Cntl_sub_trsm( cntl ) );
/*------------------------------------------------------------*/
FLA_Cont_with_3x1_to_2x1( &BT, B0,
B1,
/* ** */ /* ** */
&BB, B2, FLA_TOP );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Trsm_luh_blk_var2( FLA_Diag diagA, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, fla_trsm_t* cntl )
{
FLA_Obj ATL, ATR, A00, A01, A02,
ABL, ABR, A10, A11, A12,
A20, A21, A22;
FLA_Obj BT, B0,
BB, B1,
B2;
dim_t b;
FLA_Scal_internal( alpha, B,
FLA_Cntl_sub_scal( cntl ) );
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, 0, 0, FLA_TL );
FLA_Part_2x1( B, &BT,
&BB, 0, FLA_TOP );
while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ){
b = FLA_Determine_blocksize( ABR, FLA_BR, FLA_Cntl_blocksize( cntl ) );
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &A01, &A02,
/* ************* */ /* ******************** */
&A10, /**/ &A11, &A12,
ABL, /**/ ABR, &A20, /**/ &A21, &A22,
b, b, FLA_BR );
FLA_Repart_2x1_to_3x1( BT, &B0,
/* ** */ /* ** */
&B1,
BB, &B2, b, FLA_BOTTOM );
/*------------------------------------------------------------*/
/* B1 = triu( A11' ) \ B1 */
FLA_Trsm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR, FLA_CONJ_TRANSPOSE, diagA,
FLA_ONE, A11, B1,
FLA_Cntl_sub_trsm( cntl ) );
/* B2 = B2 - A12' * B1 */
FLA_Gemm_internal( FLA_CONJ_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_MINUS_ONE, A12, B1, FLA_ONE, B2,
FLA_Cntl_sub_gemm( cntl ) );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, A01, /**/ A02,
A10, A11, /**/ A12,
/* ************** */ /* ****************** */
&ABL, /**/ &ABR, A20, A21, /**/ A22,
FLA_TL );
FLA_Cont_with_3x1_to_2x1( &BT, B0,
B1,
/* ** */ /* ** */
&BB, B2, FLA_TOP );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Apply_Q_UT_lnfc_blk_var1( FLA_Obj A, FLA_Obj T, FLA_Obj W, FLA_Obj B, fla_apqut_t* cntl )
/*
Apply a unitary matrix Q to a matrix B from the left,
B := Q B
where Q is the forward product of Householder transformations:
Q = H(0) H(1) ... H(k-1)
where H(i) corresponds to the Householder vector stored below the diagonal
in the ith column of A. Thus, the operation becomes:
B := Q B
= H(0) H(1) ... H(k-1) B
From this, we can see that we must move through A from bottom-right to top-
left, since the Householder vector for H(k-1) was stored in the last column
of A. We intend to apply blocks of reflectors at a time, where a block
reflector H of b consecutive Householder transforms may be expressed as:
H = ( H(i) H(i+1) ... H(i+b-1) )
= ( I - U inv(T) U' )
where:
- U is the strictly lower trapezoidal (with implicit unit diagonal) matrix
of Householder vectors, stored below the diagonal of A in columns i through
i+b-1, corresponding to H(i) through H(i+b-1).
- T is the upper triangular block Householder matrix corresponding to
Householder vectors i through i+b-1.
Consider applying H to B as an intermediate step towards applying all of Q:
B := H B
= ( I - U inv(T) U' ) B
= B - U inv(T) U' B
We must move from bottom-right to top-left. So, we partition:
U -> / U11 \ B -> / B1 \ T -> ( T2 T1 )
\ U21 / \ B2 /
where:
- U11 is stored in strictly lower triangle of A11 with implicit unit
diagonal.
- U21 is stored in A21.
- T1 is an upper triangular block of row-panel matrix T.
Substituting repartitioned U, B, and T, we have:
/ B1 \ := / B1 \ - / U11 \ inv(T1) / U11 \' / B1 \
\ B2 / \ B2 / \ U21 / \ U21 / \ B2 /
= / B1 \ - / U11 \ inv(T1) ( U11' U21' ) / B1 \
\ B2 / \ U21 / \ B2 /
= / B1 \ - / U11 \ inv(T1) ( U11' B1 + U21' B2 )
\ B2 / \ U21 /
Thus, B1 is updated as:
B1 := B1 - U11 inv(T1) ( U11' B1 + U21' B2 )
And B2 is updated as:
B2 := B2 - U21 inv(T1) ( U11' B1 + U21' B2 )
Note that:
inv(T1) ( U11' B1 + U21' B2 )
is common to both updates, and thus may be computed and stored in
workspace, and then re-used.
-FGVZ
*/
{
FLA_Obj ATL, ATR, A00, A01, A02,
ABL, ABR, A10, A11, A12,
A20, A21, A22;
FLA_Obj TL, TR, T0, T1, T2;
FLA_Obj T1T,
T2B;
FLA_Obj WTL, WTR,
WBL, WBR;
FLA_Obj BT, B0,
BB, B1,
B2;
dim_t b_alg, b;
dim_t m_BR, n_BR;
// Query the algorithmic blocksize by inspecting the length of T.
b_alg = FLA_Obj_length( T );
// If m > n, then we have to initialize our partitionings carefully so
// that we begin in the proper location in A and B (since we traverse
// matrix A from BR to TL).
if ( FLA_Obj_length( A ) > FLA_Obj_width( A ) )
{
m_BR = FLA_Obj_length( A ) - FLA_Obj_width( A );
n_BR = 0;
}
else if ( FLA_Obj_length( A ) < FLA_Obj_width( A ) )
{
m_BR = 0;
n_BR = FLA_Obj_width( A ) - FLA_Obj_length( A );
}
else
{
m_BR = 0;
n_BR = 0;
}
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, m_BR, n_BR, FLA_BR );
// A and T are dependent; we determine T matrix w.r.t. A
FLA_Part_1x2( T, &TL, &TR, FLA_Obj_min_dim( A ), FLA_LEFT );
FLA_Part_2x1( B, &BT,
&BB, m_BR, FLA_BOTTOM );
while ( FLA_Obj_min_dim( ATL ) > 0 ){
b = min( b_alg, FLA_Obj_min_dim( ATL ) );
// Since T was filled from left to right, and since we need to access them
// in reverse order, we need to handle the case where the last block is
// smaller than the other b x b blocks.
if ( FLA_Obj_width( TR ) == 0 && FLA_Obj_width( T ) % b_alg > 0 )
b = FLA_Obj_width( T ) % b_alg;
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, &A01, /**/ &A02,
&A10, &A11, /**/ &A12,
/* ************* */ /* ******************** */
ABL, /**/ ABR, &A20, &A21, /**/ &A22,
b, b, FLA_TL );
FLA_Repart_1x2_to_1x3( TL, /**/ TR, &T0, &T1, /**/ &T2,
b, FLA_LEFT );
FLA_Repart_2x1_to_3x1( BT, &B0,
&B1,
/* ** */ /* ** */
BB, &B2, b, FLA_TOP );
/*------------------------------------------------------------*/
FLA_Part_2x1( T1, &T1T,
&T2B, b, FLA_TOP );
FLA_Part_2x2( W, &WTL, &WTR,
&WBL, &WBR, b, FLA_Obj_width( B1 ), FLA_TL );
// WTL = B1;
FLA_Copyt_internal( FLA_NO_TRANSPOSE, B1, WTL,
FLA_Cntl_sub_copyt( cntl ) );
// U11 = trilu( A11 );
// U21 = A21;
//
// WTL = inv( triu(T1T) ) * ( U11' * B1 + U21' * B2 );
FLA_Trmm_internal( FLA_LEFT, FLA_LOWER_TRIANGULAR,
FLA_CONJ_TRANSPOSE, FLA_UNIT_DIAG,
FLA_ONE, A11, WTL,
FLA_Cntl_sub_trmm1( cntl ) );
FLA_Gemm_internal( FLA_CONJ_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_ONE, A21, B2, FLA_ONE, WTL,
FLA_Cntl_sub_gemm1( cntl ) );
FLA_Trsm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
FLA_NO_TRANSPOSE, FLA_NONUNIT_DIAG,
FLA_ONE, T1T, WTL,
FLA_Cntl_sub_trsm( cntl ) );
// B2 = B2 - U21 * WTL;
// B1 = B1 - U11 * WTL;
FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_MINUS_ONE, A21, WTL, FLA_ONE, B2,
FLA_Cntl_sub_gemm2( cntl ) );
FLA_Trmm_internal( FLA_LEFT, FLA_LOWER_TRIANGULAR,
FLA_NO_TRANSPOSE, FLA_UNIT_DIAG,
FLA_MINUS_ONE, A11, WTL,
FLA_Cntl_sub_trmm2( cntl ) );
FLA_Axpyt_internal( FLA_NO_TRANSPOSE, FLA_ONE, WTL, B1,
FLA_Cntl_sub_axpyt( cntl ) );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, /**/ A01, A02,
/* ************** */ /* ****************** */
A10, /**/ A11, A12,
&ABL, /**/ &ABR, A20, /**/ A21, A22,
FLA_BR );
FLA_Cont_with_1x3_to_1x2( &TL, /**/ &TR, T0, /**/ T1, T2,
FLA_RIGHT );
FLA_Cont_with_3x1_to_2x1( &BT, B0,
/* ** */ /* ** */
B1,
&BB, B2, FLA_BOTTOM );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Apply_Q_UT_lhfr_blk_var1( FLA_Obj A, FLA_Obj T, FLA_Obj W, FLA_Obj B, fla_apqut_t* cntl )
{
/*
Apply the conjugate-transpose of a unitary matrix Q to a matrix B from the
left,
B := Q' B
where Q is the forward product of Householder transformations:
Q = H(0) H(1) ... H(k-1)
where H(i) corresponds to the Householder vector stored above the diagonal
in the ith row of A. Thus, the operation becomes:
B := Q' B
= ( H(0) H(1) ... H(k-1) )' B
= H(k-1)' ... H(1)' H(0)' B
From this, we can see that we must move through A from top-left to bottom-
right, since the Householder vector for H(0) was stored in the first row
of A. We intend to apply blocks of reflectors at a time, where a block
reflector H of b consecutive Householder transforms may be expressed as:
H = ( H(i) H(i+1) ... H(i+b-1) )'
= ( I - U inv(T) U' )'
where:
- U^T is the strictly upper trapezoidal (with implicit unit diagonal) matrix
of Householder vectors, stored above the diagonal of A in rows i through
i+b-1, corresponding to H(i) through H(i+b-1).
- T is the upper triangular block Householder matrix corresponding to
Householder vectors i through i+b-1.
Consider applying H to B as an intermediate step towards applying all of Q':
B := H B
= ( I - U inv(T) U' )' B
= ( I - U inv(T)' U' ) B
= B - U inv(T)' U' B
We must move from top-left to bottom-right. So, we partition:
U^T -> ( U11 U12 ) B -> / B1 \ T -> ( T1 T2 )
\ B2 /
where:
- U11 is stored in the strictly upper triangle of A11 with implicit unit
diagonal.
- U12 is stored in A12.
- T1 is an upper triangular block of row-panel matrix T.
Substituting repartitioned U, B, and T, we have:
/ B1 \ := / B1 \ - ( U11 U12 )^T inv(T1)' conj( U11 U12 ) / B1 \
\ B2 / \ B2 / \ B2 /
= / B1 \ - / U11^T \ inv(T1)' conj( U11 U12 ) / B1 \
\ B2 / \ U12^T / \ B2 /
= / B1 \ - / U11^T \ inv(T1)' ( conj(U11) B1 + conj(U12) B2 )
\ B2 / \ U12^T /
Thus, B1 is updated as:
B1 := B1 - U11^T inv(T1)' ( conj(U11) B1 + conj(U12) B2 )
And B2 is updated as:
B2 := B2 - U12^T inv(T1)' ( conj(U11) B1 + conj(U12) B2 )
Note that:
inv(T1)' ( conj(U11) B1 + conj(U12) B2 )
is common to both updates, and thus may be computed and stored in
workspace, and then re-used.
-FGVZ
*/
FLA_Obj ATL, ATR, A00, A01, A02,
ABL, ABR, A10, A11, A12,
A20, A21, A22;
FLA_Obj TL, TR, T0, T1, T2;
FLA_Obj T1T,
T2B;
FLA_Obj WTL, WTR,
WBL, WBR;
FLA_Obj BT, B0,
BB, B1,
B2;
dim_t b_alg, b;
// Query the algorithmic blocksize by inspecting the length of T.
b_alg = FLA_Obj_length( T );
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, 0, 0, FLA_TL );
FLA_Part_1x2( T, &TL, &TR, 0, FLA_LEFT );
FLA_Part_2x1( B, &BT,
&BB, 0, FLA_TOP );
while ( FLA_Obj_min_dim( ABR ) > 0 ){
b = min( b_alg, FLA_Obj_min_dim( ABR ) );
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &A01, &A02,
/* ************* */ /* ******************** */
&A10, /**/ &A11, &A12,
ABL, /**/ ABR, &A20, /**/ &A21, &A22,
b, b, FLA_BR );
FLA_Repart_1x2_to_1x3( TL, /**/ TR, &T0, /**/ &T1, &T2,
b, FLA_RIGHT );
FLA_Repart_2x1_to_3x1( BT, &B0,
/* ** */ /* ** */
&B1,
BB, &B2, b, FLA_BOTTOM );
/*------------------------------------------------------------*/
FLA_Part_2x1( T1, &T1T,
&T2B, b, FLA_TOP );
FLA_Part_2x2( W, &WTL, &WTR,
&WBL, &WBR, b, FLA_Obj_width( B1 ), FLA_TL );
// WTL = B1;
FLA_Copyt_internal( FLA_NO_TRANSPOSE, B1, WTL,
FLA_Cntl_sub_copyt( cntl ) );
// U11 = triuu( A11 );
// U12 = A12;
//
// WTL = inv( triu(T1T) )' * ( conj(U11) * B1 + conj(U12) * B2 );
FLA_Trmm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
FLA_CONJ_NO_TRANSPOSE, FLA_UNIT_DIAG,
FLA_ONE, A11, WTL,
FLA_Cntl_sub_trmm1( cntl ) );
FLA_Gemm_internal( FLA_CONJ_NO_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_ONE, A12, B2, FLA_ONE, WTL,
FLA_Cntl_sub_gemm1( cntl ) );
FLA_Trsm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
FLA_CONJ_TRANSPOSE, FLA_NONUNIT_DIAG,
FLA_ONE, T1T, WTL,
FLA_Cntl_sub_trsm( cntl ) );
// B2 = B2 - U12^T * WTL;
// B1 = B1 - U11^T * WTL;
FLA_Gemm_internal( FLA_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_MINUS_ONE, A12, WTL, FLA_ONE, B2,
FLA_Cntl_sub_gemm2( cntl ) );
FLA_Trmm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
FLA_TRANSPOSE, FLA_UNIT_DIAG,
FLA_MINUS_ONE, A11, WTL,
FLA_Cntl_sub_trmm2( cntl ) );
FLA_Axpyt_internal( FLA_NO_TRANSPOSE, FLA_ONE, WTL, B1,
FLA_Cntl_sub_axpyt( cntl ) );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, A01, /**/ A02,
A10, A11, /**/ A12,
/* ************** */ /* ****************** */
&ABL, /**/ &ABR, A20, A21, /**/ A22,
FLA_TL );
FLA_Cont_with_1x3_to_1x2( &TL, /**/ &TR, T0, T1, /**/ T2,
FLA_LEFT );
FLA_Cont_with_3x1_to_2x1( &BT, B0,
B1,
/* ** */ /* ** */
&BB, B2, FLA_TOP );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Apply_Q_UT_rnbr_blk_var1( FLA_Obj A, FLA_Obj T, FLA_Obj W, FLA_Obj B, fla_apqut_t* cntl )
/*
Apply a unitary matrix Q to a matrix B from the right,
B := B Q
where Q is the backward product of Householder transformations:
Q = H(k-1) ... H(1) H(0)
where H(i) corresponds to the Householder vector stored above the diagonal
in the ith row of A. Thus, the operation becomes:
B := B Q
= B ( H(k-1) ... H(1) H(0) )
= B ( H(k-1)' ... H(1)' H(0)' )
= B ( H(0) H(1) ... H(k-1) )'
= B H(k-1)' ... H(1)' H(0)'
From this, we can see that we must move through A from bottom-right to top-
left, since the Householder vector for H(k-1) was stored in the last row
of A. We intend to apply blocks of reflectors at a time, where a block
reflector H of b consecutive Householder transforms may be expressed as:
H = ( H(i) H(i+1) ... H(i+b-1) )'
= ( I - U inv(T) U' )'
where:
- U^T is the strictly upper trapezoidal (with implicit unit diagonal) matrix
of Householder vectors, stored above the diagonal of A in rows i through
i+b-1, corresponding to H(i) through H(i+b-1).
- T is the upper triangular block Householder matrix corresponding to
Householder vectors i through i+b-1.
Consider applying H to B as an intermediate step towards applying all of Q:
B := B H
= B ( I - U inv(T) U' )'
= B ( I - U inv(T)' U' )
= B - B U inv(T)' U'
We must move from bottom-right to top-left. So, we partition:
U^T -> ( U11 U12 ) B -> ( B1 B2 ) T -> ( T2 T1 )
where:
- U11 is stored in strictly upper triangle of A11 with implicit unit
diagonal.
- U12 is stored in A12.
- T1 is an upper triangular block of row-panel matrix T.
Substituting repartitioned U, B, and T, we have:
( B1 B2 ) := ( B1 B2 ) - ( B1 B2 ) ( U11 U12 )^T inv(T1)' conj( U11 U12 )
= ( B1 B2 ) - ( B1 B2 ) / U11^T \ inv(T1)' conj( U11 U12 )
\ U12^T /
= ( B1 B2 ) - ( B1 U11^T + B2 U12^T ) inv(T1)' conj( U11 U12 )
Thus, B1 is updated as:
B1 := B1 - ( B1 U11^T + B2 U12^T ) inv(T1)' conj(U11)
And B2 is updated as:
B2 := B2 - ( B1 U11^T + B2 U12^T ) inv(T1)' conj(U12)
Note that:
( B1 U11^T + B2 U12^T ) inv(T1)'
is common to both updates, and thus may be computed and stored in
workspace, and then re-used.
-FGVZ
*/
{
FLA_Obj ATL, ATR, A00, A01, A02,
ABL, ABR, A10, A11, A12,
A20, A21, A22;
FLA_Obj TL, TR, T0, T1, T2;
FLA_Obj T1T,
T2B;
FLA_Obj WTL, WTR,
WBL, WBR;
FLA_Obj BL, BR, B0, B1, B2;
dim_t b_alg, b;
dim_t m_BR, n_BR;
// Query the algorithmic blocksize by inspecting the length of T.
b_alg = FLA_Obj_length( T );
// If m < n, then we have to initialize our partitionings carefully so
// that we begin in the proper location in A and B (since we traverse
// matrix A from BR to TL).
if ( FLA_Obj_length( A ) < FLA_Obj_width( A ) )
{
m_BR = 0;
n_BR = FLA_Obj_width( A ) - FLA_Obj_length( A );
}
else if ( FLA_Obj_length( A ) > FLA_Obj_width( A ) )
{
m_BR = FLA_Obj_length( A ) - FLA_Obj_width( A );
n_BR = 0;
}
else
{
m_BR = 0;
n_BR = 0;
}
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, m_BR, n_BR, FLA_BR );
// A and T are dependent; we determine T matrix w.r.t. A
FLA_Part_1x2( T, &TL, &TR, FLA_Obj_min_dim( A ), FLA_LEFT );
// Be carefule that A contains reflector in row-wise;
// corresponding B should be partitioned with n_BR.
FLA_Part_1x2( B, &BL, &BR, n_BR, FLA_RIGHT );
while ( FLA_Obj_min_dim( ATL ) > 0 ){
b = min( b_alg, FLA_Obj_min_dim( ATL ) );
// Since T was filled from left to right, and since we need to access them
// in reverse order, we need to handle the case where the last block is
// smaller than the other b x b blocks.
if ( FLA_Obj_width( TR ) == 0 && FLA_Obj_width( T ) % b_alg > 0 )
b = FLA_Obj_width( T ) % b_alg;
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, &A01, /**/ &A02,
&A10, &A11, /**/ &A12,
/* ************* */ /* ******************** */
ABL, /**/ ABR, &A20, &A21, /**/ &A22,
b, b, FLA_TL );
FLA_Repart_1x2_to_1x3( TL, /**/ TR, &T0, &T1, /**/ &T2,
b, FLA_LEFT );
FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, &B1, /**/ &B2,
b, FLA_LEFT );
/*------------------------------------------------------------*/
FLA_Part_2x1( T1, &T1T,
&T2B, b, FLA_TOP );
FLA_Part_2x2( W, &WTL, &WTR,
&WBL, &WBR, b, FLA_Obj_length( B1 ), FLA_TL );
// WTL = B1^T;
FLA_Copyt_internal( FLA_TRANSPOSE, B1, WTL,
FLA_Cntl_sub_copyt( cntl ) );
// U11 = triuu( A11 );
// U12 = A12;
// Let WTL^T be conformal to B1.
//
// WTL^T = ( B1 * U11^T + B2 * U12^T ) * inv( triu(T1T)' );
// WTL = inv( conj(triu(T1T)) ) * ( U11 * B1^T + U12 * B2^T );
FLA_Trmm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
FLA_NO_TRANSPOSE, FLA_UNIT_DIAG,
FLA_ONE, A11, WTL,
FLA_Cntl_sub_trmm1( cntl ) );
FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_TRANSPOSE,
FLA_ONE, A12, B2, FLA_ONE, WTL,
FLA_Cntl_sub_gemm1( cntl ) );
FLA_Trsm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
FLA_CONJ_NO_TRANSPOSE, FLA_NONUNIT_DIAG,
FLA_ONE, T1T, WTL,
FLA_Cntl_sub_trsm( cntl ) );
// B2 = B2 - WTL^T * conj(U12);
// B1 = B1 - WTL^T * conj(U11);
// = B1 - ( U11' * WTL )^T;
FLA_Gemm_internal( FLA_TRANSPOSE, FLA_CONJ_NO_TRANSPOSE,
FLA_MINUS_ONE, WTL, A12, FLA_ONE, B2,
FLA_Cntl_sub_gemm2( cntl ) );
FLA_Trmm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
FLA_CONJ_TRANSPOSE, FLA_UNIT_DIAG,
FLA_MINUS_ONE, A11, WTL,
FLA_Cntl_sub_trmm2( cntl ) );
FLA_Axpyt_internal( FLA_TRANSPOSE, FLA_ONE, WTL, B1,
FLA_Cntl_sub_axpyt( cntl ) );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, /**/ A01, A02,
/* ************** */ /* ****************** */
A10, /**/ A11, A12,
&ABL, /**/ &ABR, A20, /**/ A21, A22,
FLA_BR );
FLA_Cont_with_1x3_to_1x2( &TL, /**/ &TR, T0, /**/ T1, T2,
FLA_RIGHT );
FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, /**/ B1, B2,
FLA_RIGHT );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Eig_gest_il_blk_var2( FLA_Obj A, FLA_Obj Y, FLA_Obj B, fla_eig_gest_t* cntl )
{
FLA_Obj ATL, ATR, A00, A01, A02,
ABL, ABR, A10, A11, A12,
A20, A21, A22;
FLA_Obj BTL, BTR, B00, B01, B02,
BBL, BBR, B10, B11, B12,
B20, B21, B22;
FLA_Obj YL, YR, Y10, Y11, Y12;
FLA_Obj Y10_t,
Y10_b;
dim_t b;
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, 0, 0, FLA_TL );
FLA_Part_2x2( B, &BTL, &BTR,
&BBL, &BBR, 0, 0, FLA_TL );
FLA_Part_1x2( Y, &YL, &YR, 0, FLA_LEFT );
while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ){
b = FLA_Determine_blocksize( ABR, FLA_BR, FLA_Cntl_blocksize( cntl ) );
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &A01, &A02,
/* ************* */ /* ******************** */
&A10, /**/ &A11, &A12,
ABL, /**/ ABR, &A20, /**/ &A21, &A22,
b, b, FLA_BR );
FLA_Repart_2x2_to_3x3( BTL, /**/ BTR, &B00, /**/ &B01, &B02,
/* ************* */ /* ******************** */
&B10, /**/ &B11, &B12,
BBL, /**/ BBR, &B20, /**/ &B21, &B22,
b, b, FLA_BR );
FLA_Repart_1x2_to_1x3( YL, /**/ YR, &Y10, /**/ &Y11, &Y12,
b, FLA_RIGHT );
/*------------------------------------------------------------*/
FLA_Part_2x1( Y10, &Y10_t,
&Y10_b, b, FLA_TOP );
// Y10 = 1/2 * B10 * A00;
FLA_Hemm_internal( FLA_RIGHT, FLA_LOWER_TRIANGULAR,
FLA_ONE_HALF, A00, B10, FLA_ZERO, Y10_t,
FLA_Cntl_sub_hemm( cntl ) );
// A10 = A10 - Y10;
FLA_Axpy_internal( FLA_MINUS_ONE, Y10_t, A10,
FLA_Cntl_sub_axpy1( cntl ) );
// A11 = A11 - A10 * B10' - B10 * A10';
FLA_Her2k_internal( FLA_LOWER_TRIANGULAR, FLA_NO_TRANSPOSE,
FLA_MINUS_ONE, A10, B10, FLA_ONE, A11,
FLA_Cntl_sub_her2k( cntl ) );
// A11 = inv( tril( B11 ) ) * A11 * inv( tril( B11 )' );
FLA_Eig_gest_internal( FLA_INVERSE, FLA_LOWER_TRIANGULAR,
A11, Y11, B11,
FLA_Cntl_sub_eig_gest( cntl ) );
// A21 = A21 - A20 * B10';
FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_CONJ_TRANSPOSE,
FLA_MINUS_ONE, A20, B10, FLA_ONE, A21,
FLA_Cntl_sub_gemm1( cntl ) );
// A21 = A21 * inv( tril( B11 )' );
FLA_Trsm_internal( FLA_RIGHT, FLA_LOWER_TRIANGULAR,
FLA_CONJ_TRANSPOSE, FLA_NONUNIT_DIAG,
FLA_ONE, B11, A21,
FLA_Cntl_sub_trsm1( cntl ) );
// A10 = A10 - Y10;
FLA_Axpy_internal( FLA_MINUS_ONE, Y10_t, A10,
FLA_Cntl_sub_axpy2( cntl ) );
// A10 = inv( tril( B11 ) ) * A10;
FLA_Trsm_internal( FLA_LEFT, FLA_LOWER_TRIANGULAR,
FLA_NO_TRANSPOSE, FLA_NONUNIT_DIAG,
FLA_ONE, B11, A10,
FLA_Cntl_sub_trsm2( cntl ) );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, A01, /**/ A02,
A10, A11, /**/ A12,
/* ************** */ /* ****************** */
&ABL, /**/ &ABR, A20, A21, /**/ A22,
FLA_TL );
FLA_Cont_with_3x3_to_2x2( &BTL, /**/ &BTR, B00, B01, /**/ B02,
B10, B11, /**/ B12,
/* ************** */ /* ****************** */
&BBL, /**/ &BBR, B20, B21, /**/ B22,
FLA_TL );
FLA_Cont_with_1x3_to_1x2( &YL, /**/ &YR, Y10, Y11, /**/ Y12,
FLA_LEFT );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Apply_Q_UT_rhbc_blk_var1( FLA_Obj A, FLA_Obj T, FLA_Obj W, FLA_Obj B, fla_apqut_t* cntl )
/*
Apply the conjugate-transpose of a unitary matrix Q to a matrix B from the
right,
B := B Q'
where Q is the backward product of Householder transformations:
Q = H(k-1) ... H(1) H(0)
where H(i) corresponds to the Householder vector stored below the diagonal
in the ith column of A. Thus, the operation becomes:
B := B Q
= B ( H(k-1) ... H(1) H(0) )'
= B ( H(k-1)' ... H(1)' H(0)' )'
= B ( H(0) H(1) ... H(k-1) )
= B H(0) H(1) ... H(k-1)
From this, we can see that we must move through A from top-left to bottom-
right, since the Householder vector for H(0) was stored in the first column
of A. We intend to apply blocks of reflectors at a time, where a block
reflector H of b consecutive Householder transforms may be expressed as:
H = ( H(i) H(i+1) ... H(i+b-1) )
= ( I - U inv(T) U' )
where:
- U is the strictly lower trapezoidal (with implicit unit diagonal) matrix
of Householder vectors, stored below the diagonal of A in columns i through
i+b-1, corresponding to H(i) through H(i+b-1).
- T is the upper triangular block Householder matrix corresponding to
Householder vectors i through i+b-1.
Consider applying H to B as an intermediate step towards applying all of Q':
B := B H
= B ( I - U inv(T) U' )
= B - B U inv(T) U'
We must move from top-left to bottom-right. So, we partition:
U -> / U11 \ B -> ( B1 B2 ) T -> ( T1 T2 )
\ U21 /
where:
- U11 is stored in strictly lower triangle of A11 with implicit unit
diagonal.
- U21 is stored in A21.
- T1 is an upper triangular block of row-panel matrix T.
Substituting repartitioned U, B, and T, we have:
( B1 B2 ) := ( B1 B2 ) - ( B1 B2 ) / U11 \ inv(T1) / U11 \'
\ U21 / \ U21 /
= ( B1 B2 ) - ( B1 B2 ) / U11 \ inv(T1) ( U11' U21' )
\ U21 /
= ( B1 B2 ) - ( B1 U11 + B2 U21 ) inv(T1) ( U11' U21' )
Thus, B1 is updated as:
B1 := B1 - ( B1 U11 + B2 U21 ) inv(T1) U11'
And B2 is updated as:
B2 := B2 - ( B1 U11 + B2 U21 ) inv(T1) U21'
Note that:
( B1 U11 + B2 U21 ) inv(T1)
is common to both updates, and thus may be computed and stored in
workspace, and then re-used.
-FGVZ
*/
{
FLA_Obj ATL, ATR, A00, A01, A02,
ABL, ABR, A10, A11, A12,
A20, A21, A22;
FLA_Obj TL, TR, T0, T1, T2;
FLA_Obj T1T,
T2B;
FLA_Obj WTL, WTR,
WBL, WBR;
FLA_Obj BL, BR, B0, B1, B2;
dim_t b_alg, b;
// Query the algorithmic blocksize by inspecting the length of T.
b_alg = FLA_Obj_length( T );
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, 0, 0, FLA_TL );
FLA_Part_1x2( T, &TL, &TR, 0, FLA_LEFT );
FLA_Part_1x2( B, &BL, &BR, 0, FLA_LEFT );
while ( FLA_Obj_min_dim( ABR ) > 0 ){
b = min( b_alg, FLA_Obj_min_dim( ABR ) );
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &A01, &A02,
/* ************* */ /* ******************** */
&A10, /**/ &A11, &A12,
ABL, /**/ ABR, &A20, /**/ &A21, &A22,
b, b, FLA_BR );
FLA_Repart_1x2_to_1x3( TL, /**/ TR, &T0, /**/ &T1, &T2,
b, FLA_RIGHT );
FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, /**/ &B1, &B2,
b, FLA_RIGHT );
/*------------------------------------------------------------*/
FLA_Part_2x1( T1, &T1T,
&T2B, b, FLA_TOP );
FLA_Part_2x2( W, &WTL, &WTR,
&WBL, &WBR, b, FLA_Obj_length( B1 ), FLA_TL );
// WTL = B1^T;
FLA_Copyt_internal( FLA_TRANSPOSE, B1, WTL,
FLA_Cntl_sub_copyt( cntl ) );
// U11 = trilu( A11 );
// U21 = A21;
// Let WTL^T be conformal to B1.
//
// WTL^T = ( B1 * U11 + B2 * U21 ) * inv( triu(T1T) );
// WTL = inv( triu(T1T)^T ) * ( U11^T * B1^T + U21^T * B2^T );
FLA_Trmm_internal( FLA_LEFT, FLA_LOWER_TRIANGULAR,
FLA_TRANSPOSE, FLA_UNIT_DIAG,
FLA_ONE, A11, WTL,
FLA_Cntl_sub_trmm1( cntl ) );
FLA_Gemm_internal( FLA_TRANSPOSE, FLA_TRANSPOSE,
FLA_ONE, A21, B2, FLA_ONE, WTL,
FLA_Cntl_sub_gemm1( cntl ) );
FLA_Trsm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
FLA_TRANSPOSE, FLA_NONUNIT_DIAG,
FLA_ONE, T1T, WTL,
FLA_Cntl_sub_trsm( cntl ) );
// B2 = B2 - WTL^T * U21';
// B1 = B1 - WTL^T * U11';
// = B1 - ( conj(U11) * WTL )^T;
FLA_Gemm_internal( FLA_TRANSPOSE, FLA_CONJ_TRANSPOSE,
FLA_MINUS_ONE, WTL, A21, FLA_ONE, B2,
FLA_Cntl_sub_gemm2( cntl ) );
FLA_Trmm_internal( FLA_LEFT, FLA_LOWER_TRIANGULAR,
FLA_CONJ_NO_TRANSPOSE, FLA_UNIT_DIAG,
FLA_MINUS_ONE, A11, WTL,
FLA_Cntl_sub_trmm2( cntl ) );
FLA_Axpyt_internal( FLA_TRANSPOSE, FLA_ONE, WTL, B1,
FLA_Cntl_sub_axpyt( cntl ) );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, A01, /**/ A02,
A10, A11, /**/ A12,
/* ************** */ /* ****************** */
&ABL, /**/ &ABR, A20, A21, /**/ A22,
FLA_TL );
FLA_Cont_with_1x3_to_1x2( &TL, /**/ &TR, T0, T1, /**/ T2,
FLA_LEFT );
FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, B1, /**/ B2,
FLA_LEFT );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Apply_QUD_UT_lhfc_blk_var1( FLA_Obj T, FLA_Obj W,
FLA_Obj R,
FLA_Obj U, FLA_Obj C,
FLA_Obj V, FLA_Obj D, fla_apqudut_t* cntl )
{
FLA_Obj TL, TR, T0, T1, T2;
FLA_Obj UL, UR, U0, U1, U2;
FLA_Obj VL, VR, V0, V1, V2;
FLA_Obj RT, R0,
RB, R1,
R2;
FLA_Obj T1T,
T1B;
FLA_Obj W1TL, W1TR,
W1BL, W1BR;
dim_t b_alg, b;
// Query the algorithmic blocksize by inspecting the length of T.
b_alg = FLA_Obj_length( T );
FLA_Part_1x2( T, &TL, &TR, 0, FLA_LEFT );
FLA_Part_1x2( U, &UL, &UR, 0, FLA_LEFT );
FLA_Part_1x2( V, &VL, &VR, 0, FLA_LEFT );
FLA_Part_2x1( R, &RT,
&RB, 0, FLA_TOP );
while ( FLA_Obj_width( UL ) < FLA_Obj_width( U ) ){
b = min( b_alg, FLA_Obj_width( UR ) );
FLA_Repart_1x2_to_1x3( TL, /**/ TR, &T0, /**/ &T1, &T2,
b, FLA_RIGHT );
FLA_Repart_1x2_to_1x3( UL, /**/ UR, &U0, /**/ &U1, &U2,
b, FLA_RIGHT );
FLA_Repart_1x2_to_1x3( VL, /**/ VR, &V0, /**/ &V1, &V2,
b, FLA_RIGHT );
FLA_Repart_2x1_to_3x1( RT, &R0,
/* ** */ /* ** */
&R1,
RB, &R2, b, FLA_BOTTOM );
/*------------------------------------------------------------*/
FLA_Part_2x1( T1, &T1T,
&T1B, b, FLA_TOP );
FLA_Part_2x2( W, &W1TL, &W1TR,
&W1BL, &W1BR, b, FLA_Obj_width( R1 ), FLA_TL );
// W1TL = R1;
FLA_Copyt_internal( FLA_NO_TRANSPOSE, R1, W1TL,
FLA_Cntl_sub_copyt( cntl ) );
// W1TL = inv( triu( T1T ) )' * ( R1 + U1' * C + V1' * D );
FLA_Gemm_internal( FLA_CONJ_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_ONE, U1, C, FLA_ONE, W1TL,
FLA_Cntl_sub_gemm1( cntl ) );
FLA_Gemm_internal( FLA_CONJ_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_ONE, V1, D, FLA_ONE, W1TL,
FLA_Cntl_sub_gemm2( cntl ) );
FLA_Trsm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
FLA_CONJ_TRANSPOSE, FLA_NONUNIT_DIAG,
FLA_ONE, T1T, W1TL,
FLA_Cntl_sub_trsm( cntl ) );
// R1 = R1 - W1TL;
// C = C - U1 * W1TL;
// D = D + V1 * W1TL;
FLA_Axpyt_internal( FLA_NO_TRANSPOSE, FLA_MINUS_ONE, W1TL, R1,
FLA_Cntl_sub_axpyt( cntl ) );
FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_MINUS_ONE, U1, W1TL, FLA_ONE, C,
FLA_Cntl_sub_gemm3( cntl ) );
FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE,
FLA_ONE, V1, W1TL, FLA_ONE, D,
FLA_Cntl_sub_gemm4( cntl ) );
/*------------------------------------------------------------*/
FLA_Cont_with_1x3_to_1x2( &TL, /**/ &TR, T0, T1, /**/ T2,
FLA_LEFT );
FLA_Cont_with_1x3_to_1x2( &UL, /**/ &UR, U0, U1, /**/ U2,
FLA_LEFT );
FLA_Cont_with_1x3_to_1x2( &VL, /**/ &VR, V0, V1, /**/ V2,
FLA_LEFT );
FLA_Cont_with_3x1_to_2x1( &RT, R0,
R1,
/* ** */ /* ** */
&RB, R2, FLA_TOP );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Trsm_internal( FLA_Side side, FLA_Uplo uplo, FLA_Trans transa, FLA_Diag diag, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, fla_trsm_t* cntl )
{
FLA_Error r_val = FLA_SUCCESS;
if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
FLA_Trsm_internal_check( side, uplo, transa, diag, alpha, A, B, cntl );
if ( FLA_Cntl_matrix_type( cntl ) == FLA_HIER &&
FLA_Obj_elemtype( A ) == FLA_MATRIX &&
FLA_Cntl_variant( cntl ) == FLA_SUBPROBLEM )
{
// Recurse
r_val = FLA_Trsm_internal( side,
uplo,
transa,
diag,
alpha,
*FLASH_OBJ_PTR_AT( A ),
*FLASH_OBJ_PTR_AT( B ),
flash_trsm_cntl_mm );
}
else if ( FLA_Cntl_matrix_type( cntl ) == FLA_HIER &&
FLA_Obj_elemtype( A ) == FLA_SCALAR &&
FLASH_Queue_get_enabled( ) )
{
// Enqueue
ENQUEUE_FLASH_Trsm( side, uplo, transa, diag, alpha, A, B, cntl );
}
else
{
if ( FLA_Cntl_matrix_type( cntl ) == FLA_HIER &&
FLA_Obj_elemtype( A ) == FLA_SCALAR &&
!FLASH_Queue_get_enabled( ) )
{
// Execute leaf
cntl = flash_trsm_cntl_blas;
}
// Parameter combinations
if ( side == FLA_LEFT )
{
if ( uplo == FLA_LOWER_TRIANGULAR )
{
if ( transa == FLA_NO_TRANSPOSE )
r_val = FLA_Trsm_lln( diag, alpha, A, B, cntl );
else if ( transa == FLA_TRANSPOSE )
r_val = FLA_Trsm_llt( diag, alpha, A, B, cntl );
else if ( transa == FLA_CONJ_NO_TRANSPOSE )
r_val = FLA_Trsm_llc( diag, alpha, A, B, cntl );
else if ( transa == FLA_CONJ_TRANSPOSE )
r_val = FLA_Trsm_llh( diag, alpha, A, B, cntl );
}
else if ( uplo == FLA_UPPER_TRIANGULAR )
{
if ( transa == FLA_NO_TRANSPOSE )
r_val = FLA_Trsm_lun( diag, alpha, A, B, cntl );
else if ( transa == FLA_TRANSPOSE )
r_val = FLA_Trsm_lut( diag, alpha, A, B, cntl );
else if ( transa == FLA_CONJ_NO_TRANSPOSE )
r_val = FLA_Trsm_luc( diag, alpha, A, B, cntl );
else if ( transa == FLA_CONJ_TRANSPOSE )
r_val = FLA_Trsm_luh( diag, alpha, A, B, cntl );
}
}
else if ( side == FLA_RIGHT )
{
if ( uplo == FLA_LOWER_TRIANGULAR )
{
if ( transa == FLA_NO_TRANSPOSE )
r_val = FLA_Trsm_rln( diag, alpha, A, B, cntl );
else if ( transa == FLA_TRANSPOSE )
r_val = FLA_Trsm_rlt( diag, alpha, A, B, cntl );
else if ( transa == FLA_CONJ_NO_TRANSPOSE )
r_val = FLA_Trsm_rlc( diag, alpha, A, B, cntl );
else if ( transa == FLA_CONJ_TRANSPOSE )
r_val = FLA_Trsm_rlh( diag, alpha, A, B, cntl );
}
else if ( uplo == FLA_UPPER_TRIANGULAR )
{
if ( transa == FLA_NO_TRANSPOSE )
r_val = FLA_Trsm_run( diag, alpha, A, B, cntl );
else if ( transa == FLA_TRANSPOSE )
r_val = FLA_Trsm_rut( diag, alpha, A, B, cntl );
else if ( transa == FLA_CONJ_NO_TRANSPOSE )
r_val = FLA_Trsm_ruc( diag, alpha, A, B, cntl );
else if ( transa == FLA_CONJ_TRANSPOSE )
r_val = FLA_Trsm_ruh( diag, alpha, A, B, cntl );
}
}
}
return r_val;
}
FLA_Error FLA_Apply_Q_UT_rnfr_blk_var3( FLA_Obj A, FLA_Obj TW, FLA_Obj W, FLA_Obj B, fla_apqut_t* cntl )
{
FLA_Obj ATL, ATR, A00, A01, A02,
ABL, ABR, A10, A11, A12,
A20, A21, A22;
FLA_Obj TWTL, TWTR, TW00, TW01, TW02,
TWBL, TWBR, TW10, T11, W12,
TW20, TW21, TW22;
FLA_Obj WTL, WTR,
WBL, WBR;
FLA_Obj BL, BR, B0, B1, B2;
dim_t b;
FLA_Part_2x2( A, &ATL, &ATR,
&ABL, &ABR, 0, 0, FLA_TL );
FLA_Part_2x2( TW, &TWTL, &TWTR,
&TWBL, &TWBR, 0, 0, FLA_TL );
FLA_Part_1x2( B, &BL, &BR, 0, FLA_LEFT );
while ( FLA_Obj_min_dim( ABR ) > 0 ){
b = FLA_Determine_blocksize( ABR, FLA_BR, FLA_Cntl_blocksize( cntl ) );
FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &A01, &A02,
/* ************* */ /* ******************** */
&A10, /**/ &A11, &A12,
ABL, /**/ ABR, &A20, /**/ &A21, &A22,
b, b, FLA_BR );
FLA_Repart_2x2_to_3x3( TWTL, /**/ TWTR, &TW00, /**/ &TW01, &TW02,
/* *************** */ /* *********************** */
&TW10, /**/ &T11, &W12,
TWBL, /**/ TWBR, &TW20, /**/ &TW21, &TW22,
b, b, FLA_BR );
FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, /**/ &B1, &B2,
b, FLA_RIGHT );
/*------------------------------------------------------------*/
FLA_Part_2x2( W, &WTL, &WTR,
&WBL, &WBR, b, FLA_Obj_length( B1 ), FLA_TL );
// WTL = B1;
FLA_Copyt_internal( FLA_TRANSPOSE, B1, WTL,
FLA_Cntl_sub_copyt( cntl ) );
// U11 = trilu( A11 );
// U12 = A12;
// Let WTL^T be conformal to B1.
//
// WTL^T = ( B1 * U11^T + B2 * U12^T ) * inv( triu(T11) );
// WTL = inv( triu(T11) )^T * ( U11 * B1^T + U12 * B2^T );
FLA_Trmm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
FLA_NO_TRANSPOSE, FLA_UNIT_DIAG,
FLA_ONE, A11, WTL,
FLA_Cntl_sub_trmm1( cntl ) );
FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_TRANSPOSE,
FLA_ONE, A12, B2, FLA_ONE, WTL,
FLA_Cntl_sub_gemm1( cntl ) );
FLA_Trsm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
FLA_TRANSPOSE, FLA_NONUNIT_DIAG,
FLA_ONE, T11, WTL,
FLA_Cntl_sub_trsm( cntl ) );
// B2 = B2 - WTL^T * conj(U12);
// B1 = B1 - WTL^T * conj(U11);
// = B1 - ( U11' * WTL )^T;
FLA_Gemm_internal( FLA_TRANSPOSE, FLA_CONJ_NO_TRANSPOSE,
FLA_MINUS_ONE, WTL, A12, FLA_ONE, B2,
FLA_Cntl_sub_gemm2( cntl ) );
FLA_Trmm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
FLA_CONJ_TRANSPOSE, FLA_UNIT_DIAG,
FLA_MINUS_ONE, A11, WTL,
FLA_Cntl_sub_trmm2( cntl ) );
FLA_Axpyt_internal( FLA_TRANSPOSE, FLA_ONE, WTL, B1,
FLA_Cntl_sub_axpyt( cntl ) );
/*------------------------------------------------------------*/
FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, A01, /**/ A02,
A10, A11, /**/ A12,
/* ************** */ /* ****************** */
&ABL, /**/ &ABR, A20, A21, /**/ A22,
FLA_TL );
FLA_Cont_with_3x3_to_2x2( &TWTL, /**/ &TWTR, TW00, TW01, /**/ TW02,
TW10, T11, /**/ W12,
/* **************** */ /* ********************* */
&TWBL, /**/ &TWBR, TW20, TW21, /**/ TW22,
FLA_TL );
FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, B1, /**/ B2,
FLA_LEFT );
}
return FLA_SUCCESS;
}