FLA_Error FLA_Trmm_luh_blk_var3( FLA_Diag diagA, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, fla_trmm_t* cntl ) { FLA_Obj BL, BR, B0, B1, B2; dim_t b; FLA_Part_1x2( B, &BL, &BR, 0, FLA_LEFT ); while ( FLA_Obj_width( BL ) < FLA_Obj_width( B ) ){ b = FLA_Determine_blocksize( BR, FLA_RIGHT, FLA_Cntl_blocksize( cntl ) ); FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, /**/ &B1, &B2, b, FLA_RIGHT ); /*------------------------------------------------------------*/ /* B1 = triu( A )' * B1; */ FLA_Trmm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR, FLA_CONJ_TRANSPOSE, diagA, alpha, A, B1, FLA_Cntl_sub_trmm( cntl ) ); /*------------------------------------------------------------*/ FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, B1, /**/ B2, FLA_LEFT ); } return FLA_SUCCESS; }
FLA_Error FLA_Trmm_rlt_blk_var2( FLA_Diag diagA, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, fla_trmm_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 ); /*------------------------------------------------------------*/ /* B2 = B2 + B1 * A21'; */ FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_TRANSPOSE, FLA_ONE, B1, A21, FLA_ONE, B2, FLA_Cntl_sub_gemm( cntl ) ); /* B1 = B1 * tril( A11 )'; */ FLA_Trmm_internal( FLA_RIGHT, FLA_LOWER_TRIANGULAR, FLA_TRANSPOSE, diagA, FLA_ONE, A11, B1, FLA_Cntl_sub_trmm( 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_Trinv_uu_blk_var4( 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 = -A12 / triuu( A22 ); FLA_Trsm_internal( FLA_RIGHT, FLA_UPPER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_NONUNIT_DIAG, FLA_MINUS_ONE, A22, A12, FLA_Cntl_sub_trsm1( cntl ) ); // A02 = -A01 * A12 + A02; FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE, FLA_MINUS_ONE, A01, A12, FLA_ONE, A02, FLA_Cntl_sub_gemm( cntl ) ); // A01 = A00 * A01; FLA_Trmm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_NONUNIT_DIAG, FLA_ONE, A00, A01, FLA_Cntl_sub_trmm( 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_Ttmm_u_blk_var1( FLA_Obj A, fla_ttmm_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 ); /*------------------------------------------------------------*/ // A00 = A00 + A01 * A01' FLA_Herk_internal( FLA_UPPER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_ONE, A01, FLA_ONE, A00, FLA_Cntl_sub_herk( cntl ) ); // A01 = A01 * triu( A11 )' FLA_Trmm_internal( FLA_RIGHT, FLA_UPPER_TRIANGULAR, FLA_CONJ_TRANSPOSE, FLA_NONUNIT_DIAG, FLA_ONE, A11, A01, FLA_Cntl_sub_trmm( cntl ) ); // A11 = triu( A11 ) * triu( A11 )' FLA_Ttmm_internal( FLA_UPPER_TRIANGULAR, A11, FLA_Cntl_sub_ttmm( 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_Trmm_run_blk_var4( FLA_Diag diagA, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, fla_trmm_t* cntl ) { FLA_Obj BT, B0, BB, B1, B2; dim_t b; FLA_Part_2x1( B, &BT, &BB, 0, FLA_BOTTOM ); while ( FLA_Obj_length( BB ) < FLA_Obj_length( B ) ){ b = FLA_Determine_blocksize( BT, FLA_TOP, FLA_Cntl_blocksize( cntl ) ); FLA_Repart_2x1_to_3x1( BT, &B0, &B1, /* ** */ /* ** */ BB, &B2, b, FLA_TOP ); /*------------------------------------------------------------*/ /* B1 = B1 * triu( A ); */ FLA_Trmm_internal( FLA_RIGHT, FLA_UPPER_TRIANGULAR, FLA_NO_TRANSPOSE, diagA, alpha, A, B1, FLA_Cntl_sub_trmm( cntl ) ); /*------------------------------------------------------------*/ FLA_Cont_with_3x1_to_2x1( &BT, B0, /* ** */ /* ** */ B1, &BB, B2, FLA_BOTTOM ); } return FLA_SUCCESS; }
FLA_Error FLA_Eig_gest_nl_blk_var1( 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 YT, Y01, YB, Y11, Y21; FLA_Obj Y21_l, Y21_r; 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_2x1( Y, &YT, &YB, 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_2x2_to_3x3( BTL, /**/ BTR, &B00, /**/ &B01, &B02, /* ************* */ /* ******************** */ &B10, /**/ &B11, &B12, BBL, /**/ BBR, &B20, /**/ &B21, &B22, b, b, FLA_BR ); FLA_Repart_2x1_to_3x1( YT, &Y01, /* ** */ /* *** */ &Y11, YB, &Y21, b, FLA_BOTTOM ); /*------------------------------------------------------------*/ FLA_Part_1x2( Y21, &Y21_l, &Y21_r, b, FLA_LEFT ); // Y21 = A22 * B21; FLA_Hemm_internal( FLA_LEFT, FLA_LOWER_TRIANGULAR, FLA_ONE, A22, B21, FLA_ZERO, Y21_l, FLA_Cntl_sub_hemm( cntl ) ); // A21 = A21 * tril( B11 ); FLA_Trmm_internal( FLA_RIGHT, FLA_LOWER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_NONUNIT_DIAG, FLA_ONE, B11, A21, FLA_Cntl_sub_trmm1( cntl ) ); // A21 = A21 + 1/2 * Y21; FLA_Axpy_internal( FLA_ONE_HALF, Y21_l, A21, FLA_Cntl_sub_axpy1( cntl ) ); // A11 = tril( B11 )' * A11 * tril( B11 ); FLA_Eig_gest_internal( FLA_NO_INVERSE, FLA_LOWER_TRIANGULAR, A11, Y11, B11, FLA_Cntl_sub_eig_gest( cntl ) ); // A11 = A11 + A21' * B21 + B21' * A21; FLA_Her2k_internal( FLA_LOWER_TRIANGULAR, FLA_CONJ_TRANSPOSE, FLA_ONE, A21, B21, FLA_ONE, A11, FLA_Cntl_sub_her2k( cntl ) ); // A21 = A21 + 1/2 * Y21; FLA_Axpy_internal( FLA_ONE_HALF, Y21_l, A21, FLA_Cntl_sub_axpy2( cntl ) ); // A21 = tril( B22 )' * A21; FLA_Trmm_internal( FLA_LEFT, FLA_LOWER_TRIANGULAR, FLA_CONJ_TRANSPOSE, FLA_NONUNIT_DIAG, FLA_ONE, B22, A21, FLA_Cntl_sub_trmm2( 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_3x1_to_2x1( &YT, Y01, Y11, /* ** */ /* *** */ &YB, Y21, FLA_TOP ); } return FLA_SUCCESS; }
FLA_Error FLA_Trmm_llt_blk_var1( FLA_Diag diagA, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, fla_trmm_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_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 = tril( A11 )' * B1; */ FLA_Trmm_internal( FLA_LEFT, FLA_LOWER_TRIANGULAR, FLA_TRANSPOSE, diagA, alpha, A11, B1, FLA_Cntl_sub_trmm( cntl ) ); /* B1 = B1 + A21' * B2; */ FLA_Gemm_internal( FLA_TRANSPOSE, FLA_NO_TRANSPOSE, alpha, A21, B2, FLA_ONE, B1, 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_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_Eig_gest_nl_blk_var4( 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 = A11 * B10; FLA_Hemm_internal( FLA_LEFT, FLA_LOWER_TRIANGULAR, FLA_ONE, A11, B10, FLA_ZERO, Y10_t, FLA_Cntl_sub_hemm( cntl ) ); // A10 = A10 + 1/2 * Y10; FLA_Axpy_internal( FLA_ONE_HALF, Y10_t, A10, FLA_Cntl_sub_axpy1( cntl ) ); // A00 = A00 + A10' * B10 + B10' * A10; FLA_Her2k_internal( FLA_LOWER_TRIANGULAR, FLA_CONJ_TRANSPOSE, FLA_ONE, A10, B10, FLA_ONE, A00, FLA_Cntl_sub_her2k( cntl ) ); // A10 = A10 + 1/2 * Y10; FLA_Axpy_internal( FLA_ONE_HALF, Y10_t, A10, FLA_Cntl_sub_axpy2( cntl ) ); // A10 = tril( B11 )' * A10; FLA_Trmm_internal( FLA_LEFT, FLA_LOWER_TRIANGULAR, FLA_CONJ_TRANSPOSE, FLA_NONUNIT_DIAG, FLA_ONE, B11, A10, FLA_Cntl_sub_trmm1( cntl ) ); // A11 = tril( B11 )' * A11 * tril( B11 ); FLA_Eig_gest_internal( FLA_NO_INVERSE, FLA_LOWER_TRIANGULAR, A11, Y11, B11, FLA_Cntl_sub_eig_gest( cntl ) ); // A20 = A20 + A21 * B10; FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE, FLA_ONE, A21, B10, FLA_ONE, A20, FLA_Cntl_sub_gemm1( cntl ) ); // A21 = A21 * tril( B11 ); FLA_Trmm_internal( FLA_RIGHT, FLA_LOWER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_NONUNIT_DIAG, FLA_ONE, B11, A21, FLA_Cntl_sub_trmm2( 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_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; }
FLA_Error FLA_Trmm_internal( FLA_Side side, FLA_Uplo uplo, FLA_Trans transa, FLA_Diag diag, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, fla_trmm_t* cntl ) { FLA_Error r_val = FLA_SUCCESS; if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) FLA_Trmm_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_Trmm_internal( side, uplo, transa, diag, alpha, *FLASH_OBJ_PTR_AT( A ), *FLASH_OBJ_PTR_AT( B ), flash_trmm_cntl_mm ); } else if ( FLA_Cntl_matrix_type( cntl ) == FLA_HIER && FLA_Obj_elemtype( A ) == FLA_SCALAR && FLASH_Queue_get_enabled( ) ) { // Enqueue ENQUEUE_FLASH_Trmm( 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_trmm_cntl_blas; } // Parameter combinations if ( side == FLA_LEFT ) { if ( uplo == FLA_LOWER_TRIANGULAR ) { if ( transa == FLA_NO_TRANSPOSE ) r_val = FLA_Trmm_lln( diag, alpha, A, B, cntl ); else if ( transa == FLA_TRANSPOSE ) r_val = FLA_Trmm_llt( diag, alpha, A, B, cntl ); else if ( transa == FLA_CONJ_NO_TRANSPOSE ) r_val = FLA_Trmm_llc( diag, alpha, A, B, cntl ); else if ( transa == FLA_CONJ_TRANSPOSE ) r_val = FLA_Trmm_llh( diag, alpha, A, B, cntl ); } else if ( uplo == FLA_UPPER_TRIANGULAR ) { if ( transa == FLA_NO_TRANSPOSE ) r_val = FLA_Trmm_lun( diag, alpha, A, B, cntl ); else if ( transa == FLA_TRANSPOSE ) r_val = FLA_Trmm_lut( diag, alpha, A, B, cntl ); else if ( transa == FLA_CONJ_NO_TRANSPOSE ) r_val = FLA_Trmm_luc( diag, alpha, A, B, cntl ); else if ( transa == FLA_CONJ_TRANSPOSE ) r_val = FLA_Trmm_luh( diag, alpha, A, B, cntl ); } } else if ( side == FLA_RIGHT ) { if ( uplo == FLA_LOWER_TRIANGULAR ) { if ( transa == FLA_NO_TRANSPOSE ) r_val = FLA_Trmm_rln( diag, alpha, A, B, cntl ); else if ( transa == FLA_TRANSPOSE ) r_val = FLA_Trmm_rlt( diag, alpha, A, B, cntl ); else if ( transa == FLA_CONJ_NO_TRANSPOSE ) r_val = FLA_Trmm_rlc( diag, alpha, A, B, cntl ); else if ( transa == FLA_CONJ_TRANSPOSE ) r_val = FLA_Trmm_rlh( diag, alpha, A, B, cntl ); } else if ( uplo == FLA_UPPER_TRIANGULAR ) { if ( transa == FLA_NO_TRANSPOSE ) r_val = FLA_Trmm_run( diag, alpha, A, B, cntl ); else if ( transa == FLA_TRANSPOSE ) r_val = FLA_Trmm_rut( diag, alpha, A, B, cntl ); else if ( transa == FLA_CONJ_NO_TRANSPOSE ) r_val = FLA_Trmm_ruc( diag, alpha, A, B, cntl ); else if ( transa == FLA_CONJ_TRANSPOSE ) r_val = FLA_Trmm_ruh( diag, alpha, A, B, cntl ); } } } return r_val; }