FLA_Error FLA_Gemm_tn_unb_var1( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C ) { FLA_Obj AL, AR, A0, a1, A2; FLA_Obj CT, C0, CB, c1t, C2; FLA_Scal_external( beta, C ); FLA_Part_1x2( A, &AL, &AR, 0, FLA_LEFT ); FLA_Part_2x1( C, &CT, &CB, 0, FLA_TOP ); while ( FLA_Obj_width( AL ) < FLA_Obj_width( A ) ){ FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, /**/ &a1, &A2, 1, FLA_RIGHT ); FLA_Repart_2x1_to_3x1( CT, &C0, /* ** */ /* *** */ &c1t, CB, &C2, 1, FLA_BOTTOM ); /*------------------------------------------------------------*/ /* c1t = a1' * B + c1t */ /* c1t' = B' * a1 + c1t' */ FLA_Gemv_external( FLA_TRANSPOSE, alpha, B, a1, FLA_ONE, c1t ); /*------------------------------------------------------------*/ FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, a1, /**/ A2, FLA_LEFT ); FLA_Cont_with_3x1_to_2x1( &CT, C0, c1t, /* ** */ /* *** */ &CB, C2, FLA_TOP ); } return FLA_SUCCESS; }
FLA_Error FLA_Gemm_tt_unb_var5( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C ) { FLA_Obj AT, A0, AB, a1t, A2; FLA_Obj BL, BR, B0, b1, B2; FLA_Scal_external( beta, C ); FLA_Part_2x1( A, &AT, &AB, 0, FLA_TOP ); FLA_Part_1x2( B, &BL, &BR, 0, FLA_LEFT ); while ( FLA_Obj_length( AT ) < FLA_Obj_length( A ) ){ FLA_Repart_2x1_to_3x1( AT, &A0, /* ** */ /* *** */ &a1t, AB, &A2, 1, FLA_BOTTOM ); FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, /**/ &b1, &B2, 1, FLA_RIGHT ); /*------------------------------------------------------------*/ /* C = a1t' * b1' + C */ FLA_Ger_external( alpha, a1t, b1, C ); /*------------------------------------------------------------*/ FLA_Cont_with_3x1_to_2x1( &AT, A0, a1t, /* ** */ /* *** */ &AB, A2, FLA_TOP ); FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, b1, /**/ B2, FLA_LEFT ); } return FLA_SUCCESS; }
FLA_Error FLA_Syrk_ln_omp1t_var5_fc( FLA_Obj A, FLA_Obj C, int nb_alg ) { FLA_Obj AL, AR, A0, A1, A2; FLA_Obj MyC; int b; FLA_Part_1x2( A, &AL, &AR, 0, FLA_LEFT ); #pragma intel omp parallel taskq { while ( FLA_Obj_width( AL ) < FLA_Obj_width( A ) ){ nb_alg = FLA_Obj_width( A )/omp_get_num_threads() + 1; b = min( FLA_Obj_width( AR ), nb_alg ); FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, /**/ &A1, &A2, b, FLA_RIGHT ); /*------------------------------------------------------------*/ #pragma intel omp task captureprivate(A1) private(MyC) { FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, C, &MyC ); FLA_Obj_set_to_zero( MyC ); /* MyC := A1 * A1' */ FLA_Syrk( FLA_LOWER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_ONE, A1, FLA_ZERO, MyC ); /* C := MyC */ FLA_Axpy_sync_circular( FLA_ONE, MyC, C ); FLA_Obj_free( &MyC ); } /*------------------------------------------------------------*/ FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, A1, /**/ A2, FLA_LEFT ); } } return FLA_SUCCESS; }
FLA_Error FLA_Gemm_nc_unb_var5( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C ) { FLA_Obj AL, AR, A0, a1, A2; FLA_Obj BT, B0, BB, b1t, B2; FLA_Scal_external( beta, C ); FLA_Part_1x2( A, &AL, &AR, 0, FLA_LEFT ); FLA_Part_2x1( B, &BT, &BB, 0, FLA_TOP ); while ( FLA_Obj_width( AL ) < FLA_Obj_width( A ) ){ FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, /**/ &a1, &A2, 1, FLA_RIGHT ); FLA_Repart_2x1_to_3x1( BT, &B0, /* ** */ /* *** */ &b1t, BB, &B2, 1, FLA_BOTTOM ); /*------------------------------------------------------------*/ /* C = a1 * b1t + C */ FLA_Gerc_external( FLA_NO_CONJUGATE, FLA_CONJUGATE, alpha, a1, b1t, C ); /*------------------------------------------------------------*/ FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, a1, /**/ A2, FLA_LEFT ); FLA_Cont_with_3x1_to_2x1( &BT, B0, b1t, /* ** */ /* *** */ &BB, B2, FLA_TOP ); } return FLA_SUCCESS; }
FLA_Error FLA_Gemm_ht_unb_var4( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C ) { FLA_Obj BT, B0, BB, b1t, B2; FLA_Obj CL, CR, C0, c1, C2; FLA_Scal_external( beta, C ); FLA_Part_2x1( B, &BT, &BB, 0, FLA_BOTTOM ); FLA_Part_1x2( C, &CL, &CR, 0, FLA_RIGHT ); while ( FLA_Obj_length( BB ) < FLA_Obj_length( B ) ){ FLA_Repart_2x1_to_3x1( BT, &B0, &b1t, /* ** */ /* *** */ BB, &B2, 1, FLA_TOP ); FLA_Repart_1x2_to_1x3( CL, /**/ CR, &C0, &c1, /**/ &C2, 1, FLA_LEFT ); /*------------------------------------------------------------*/ /* c1 = A' * b1t' + c1 */ FLA_Gemv_external( FLA_CONJ_TRANSPOSE, alpha, A, b1t, FLA_ONE, c1 ); /*------------------------------------------------------------*/ FLA_Cont_with_3x1_to_2x1( &BT, B0, /* ** */ /* *** */ b1t, &BB, B2, FLA_BOTTOM ); FLA_Cont_with_1x3_to_1x2( &CL, /**/ &CR, C0, /**/ c1, C2, FLA_RIGHT ); } return FLA_SUCCESS; }
FLA_Error FLA_Syrk_ln_omp1t_var5( FLA_Obj A, FLA_Obj C ) { FLA_Obj AL, AR, A0, A1, A2; FLA_Obj MyC; int b; FLA_Part_1x2( A, &AL, &AR, 0, FLA_LEFT ); #pragma intel omp parallel taskq { while ( FLA_Obj_width( AL ) < FLA_Obj_width( A ) ){ b = FLA_Task_compute_blocksize( 0, A, AL, FLA_LEFT ); FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, /**/ &A1, &A2, b, FLA_RIGHT ); /*------------------------------------------------------------*/ #pragma intel omp task captureprivate(A1) private(MyC) { FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, C, &MyC ); FLA_Obj_set_to_zero( MyC ); /* MyC := A1 * A1' */ FLA_Syrk_external( FLA_LOWER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_ONE, A1, FLA_ZERO, MyC ); /* C := MyC */ FLA_Axpy_sync_pipeline( FLA_ONE, MyC, C ); FLA_Obj_free( &MyC ); } /*------------------------------------------------------------*/ FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, A1, /**/ A2, FLA_LEFT ); } } return FLA_SUCCESS; }
int Gemm_unb_var1( FLA_Obj A, FLA_Obj B, FLA_Obj C ) { FLA_Obj AL, AR, A0, a1, A2; FLA_Obj BT, B0, BB, b1t, B2; FLA_Part_1x2( A, &AL, &AR, 0, FLA_LEFT ); FLA_Part_2x1( B, &BT, &BB, 0, FLA_TOP ); while ( FLA_Obj_width( AL ) < FLA_Obj_width( A ) ){ FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, /**/ &a1, &A2, 1, FLA_RIGHT ); FLA_Repart_2x1_to_3x1( BT, &B0, /* ** */ /* *** */ &b1t, BB, &B2, 1, FLA_BOTTOM ); /*------------------------------------------------------------*/ FLA_Ger( FLA_ONE, a1, b1t, C ); /*------------------------------------------------------------*/ FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, a1, /**/ A2, FLA_LEFT ); FLA_Cont_with_3x1_to_2x1( &BT, B0, b1t, /* ** */ /* *** */ &BB, B2, FLA_TOP ); } return FLA_SUCCESS; }
int SLAP_Syrk_ln_unb_var5( FLA_Obj C, FLA_Obj A ) { FLA_Obj AL, AR, A0, a1, A2; FLA_Part_1x2( A, &AL, &AR, 0, FLA_LEFT ); while ( FLA_Obj_width( AL ) < FLA_Obj_width( A ) ){ FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, /**/ &a1, &A2, 1, FLA_RIGHT ); /*------------------------------------------------------------*/ FLA_Syr(FLA_LOWER_TRIANGULAR, FLA_ONE, a1, C); /*------------------------------------------------------------*/ FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, a1, /**/ A2, FLA_LEFT ); } return FLA_SUCCESS; }
FLA_Error FLA_Symm_ru_blk_var4( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C, fla_symm_t* cntl ) { FLA_Obj ATL, ATR, A00, A01, A02, ABL, ABR, A10, A11, A12, A20, A21, A22; FLA_Obj BL, BR, B0, B1, B2; FLA_Obj CL, CR, C0, C1, C2; dim_t b; FLA_Scal_internal( beta, C, FLA_Cntl_sub_scal( cntl ) ); FLA_Part_2x2( A, &ATL, &ATR, &ABL, &ABR, 0, 0, FLA_TL ); FLA_Part_1x2( B, &BL, &BR, 0, FLA_LEFT ); FLA_Part_1x2( C, &CL, &CR, 0, FLA_LEFT ); while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ){ 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_1x2_to_1x3( BL, /**/ BR, &B0, /**/ &B1, &B2, b, FLA_RIGHT ); FLA_Repart_1x2_to_1x3( CL, /**/ CR, &C0, /**/ &C1, &C2, b, FLA_RIGHT ); /*------------------------------------------------------------*/ /* C0 = C0 + B1 * A01' */ FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_TRANSPOSE, alpha, B1, A01, FLA_ONE, C0, FLA_Cntl_sub_gemm1( cntl ) ); /* C1 = C1 + B1 * A11 */ FLA_Symm_internal( FLA_RIGHT, FLA_UPPER_TRIANGULAR, alpha, A11, B1, FLA_ONE, C1, FLA_Cntl_sub_symm( cntl ) ); /* C2 = C2 + B1 * A12 */ FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE, alpha, B1, A12, FLA_ONE, C2, FLA_Cntl_sub_gemm2( 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( &BL, /**/ &BR, B0, B1, /**/ B2, FLA_LEFT ); FLA_Cont_with_1x3_to_1x2( &CL, /**/ &CR, C0, C1, /**/ C2, FLA_LEFT ); } 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_QR_UT_blk_var1( FLA_Obj A, FLA_Obj T, fla_qrut_t* cntl ) { FLA_Obj ATL, ATR, A00, A01, A02, ABL, ABR, A10, A11, A12, A20, A21, A22; FLA_Obj TL, TR, T0, T1, W12; FLA_Obj T1T, T2B; FLA_Obj AB1, AB2; 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 ); 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, &W12, b, FLA_RIGHT ); /*------------------------------------------------------------*/ FLA_Part_2x1( T1, &T1T, &T2B, b, FLA_TOP ); FLA_Merge_2x1( A11, A21, &AB1 ); // Perform a QR factorization via the UT transform on AB1: // // / A11 \ -> QB1 R11 // \ A21 / // // where: // - QB1 is formed from UB1 (which is stored column-wise below the // diagonal of AB1) and T11 (which is stored to the upper triangle // of T11). // - R11 is stored to the upper triangle of AB1. FLA_QR_UT_internal( AB1, T1T, FLA_Cntl_sub_qrut( cntl ) ); if ( FLA_Obj_width( A12 ) > 0 ) { FLA_Merge_2x1( A12, A22, &AB2 ); // Apply the Householder transforms associated with UB1 and T11 to // AB2: // // / A12 \ := QB1' / A12 \ // \ A22 / \ A22 / // // where QB1 is formed from UB1 and T11. FLA_Apply_Q_UT_internal( FLA_LEFT, FLA_CONJ_TRANSPOSE, FLA_FORWARD, FLA_COLUMNWISE, AB1, T1T, W12, AB2, FLA_Cntl_sub_apqut( 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, /**/ W12, FLA_LEFT ); } return FLA_SUCCESS; }
FLA_Error FLA_Gemm_nn_omp_var5( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj C, fla_gemm_t* cntl ) { FLA_Obj AL, AR, A0, A1, A2; FLA_Obj BT, B0, BB, B1, B2; FLA_Obj C_local; int b; FLA_Part_1x2( A, &AL, &AR, 0, FLA_LEFT ); FLA_Part_2x1( B, &BT, &BB, 0, FLA_TOP ); #pragma intel omp parallel taskq { while ( FLA_Obj_width( AL ) < FLA_Obj_width( A ) ){ b = FLA_Determine_blocksize( A, AL, FLA_LEFT, FLA_Cntl_blocksize( cntl ) ); //b = min( FLA_Obj_width( AR ), nb_alg ); FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, /**/ &A1, &A2, b, FLA_RIGHT ); FLA_Repart_2x1_to_3x1( BT, &B0, /* ** */ /* ** */ &B1, BB, &B2, b, FLA_BOTTOM ); /*------------------------------------------------------------*/ #pragma intel omp task captureprivate(A1,B1) private(C_local) { FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, C, &C_local ); FLA_Obj_set_to_zero( C_local ); /* C = alpha * A1 * B1 + C; */ FLA_Gemm_external( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE, alpha, A1, B1, FLA_ONE, C_local ); REF_Axpy_sync_circular( FLA_ONE, C_local, C ); FLA_Obj_free( &C_local ); } /*------------------------------------------------------------*/ FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, A1, /**/ A2, FLA_LEFT ); FLA_Cont_with_3x1_to_2x1( &BT, B0, B1, /* ** */ /* ** */ &BB, B2, FLA_TOP ); } } return FLA_SUCCESS; }
FLA_Error FLA_Bidiag_UT_u_blk_var2( FLA_Obj A, FLA_Obj TU, FLA_Obj TV ) { FLA_Obj ATL, ATR, A00, A01, A02, ABL, ABR, A10, A11, A12, A20, A21, A22; FLA_Obj TUL, TUR, TU0, TU1, TU2; FLA_Obj TVL, TVR, TV0, TV1, TV2; FLA_Obj TU1_tl; FLA_Obj TV1_tl; FLA_Obj none, none2, none3; dim_t b_alg, b; b_alg = FLA_Obj_length( TU ); FLA_Part_2x2( A, &ATL, &ATR, &ABL, &ABR, 0, 0, FLA_TL ); FLA_Part_1x2( TU, &TUL, &TUR, 0, FLA_LEFT ); FLA_Part_1x2( TV, &TVL, &TVR, 0, FLA_LEFT ); while ( FLA_Obj_min_dim( ABR ) > 0 ) { b = min( FLA_Obj_min_dim( ABR ), b_alg ); 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( TUL, /**/ TUR, &TU0, /**/ &TU1, &TU2, b, FLA_RIGHT ); FLA_Repart_1x2_to_1x3( TVL, /**/ TVR, &TV0, /**/ &TV1, &TV2, b, FLA_RIGHT ); /*------------------------------------------------------------*/ FLA_Part_2x2( TU1, &TU1_tl, &none, &none2, &none3, b, b, FLA_TL ); FLA_Part_2x2( TV1, &TV1_tl, &none, &none2, &none3, b, b, FLA_TL ); // [ ABR, T1 ] = FLA_Bidiag_UT_u_step_unb_var2( ABR, TU1, TV1, b ); //FLA_Bidiag_UT_u_step_unb_var2( ABR, TU1_tl, TV1_tl ); //FLA_Bidiag_UT_u_step_ofu_var2( ABR, TU1_tl, TV1_tl ); FLA_Bidiag_UT_u_step_opt_var2( ABR, TU1_tl, TV1_tl ); /*------------------------------------------------------------*/ 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( &TUL, /**/ &TUR, TU0, TU1, /**/ TU2, FLA_LEFT ); FLA_Cont_with_1x3_to_1x2( &TVL, /**/ &TVR, TV0, TV1, /**/ TV2, FLA_LEFT ); } return FLA_SUCCESS; }
FLA_Error FLA_Syr2k_lt_unb_var6( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C ) { FLA_Obj AL, AR, A0, a1, A2; FLA_Obj BL, BR, B0, b1, B2; FLA_Obj CTL, CTR, C00, c01, C02, CBL, CBR, c10t, gamma11, c12t, C20, c21, C22; FLA_Scalr_external( FLA_LOWER_TRIANGULAR, beta, C ); FLA_Part_1x2( A, &AL, &AR, 0, FLA_RIGHT ); FLA_Part_1x2( B, &BL, &BR, 0, FLA_RIGHT ); FLA_Part_2x2( C, &CTL, &CTR, &CBL, &CBR, 0, 0, FLA_BR ); while ( FLA_Obj_width( AR ) < FLA_Obj_width( A ) ){ FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, &a1, /**/ &A2, 1, FLA_LEFT ); FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, &b1, /**/ &B2, 1, FLA_LEFT ); FLA_Repart_2x2_to_3x3( CTL, /**/ CTR, &C00, &c01, /**/ &C02, &c10t, &gamma11, /**/ &c12t, /* ************* */ /* ************************** */ CBL, /**/ CBR, &C20, &c21, /**/ &C22, 1, 1, FLA_TL ); /*------------------------------------------------------------*/ /* c10t = c10t + a1' * B0 */ FLA_Gemv_external( FLA_TRANSPOSE, alpha, B0, a1, FLA_ONE, c10t ); /* c21 = c21 + B2' * a1 */ FLA_Gemv_external( FLA_TRANSPOSE, alpha, B2, a1, FLA_ONE, c21 ); /* gamma11 = gamma11 + a1' * b1 + b1' * a1 */ FLA_Dot2s_external( alpha, a1, b1, FLA_ONE, gamma11 ); /*------------------------------------------------------------*/ FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, /**/ a1, A2, FLA_RIGHT ); FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, /**/ b1, B2, FLA_RIGHT ); FLA_Cont_with_3x3_to_2x2( &CTL, /**/ &CTR, C00, /**/ c01, C02, /* ************** */ /* ************************ */ c10t, /**/ gamma11, c12t, &CBL, /**/ &CBR, C20, /**/ c21, C22, FLA_BR ); } return FLA_SUCCESS; }
FLA_Error FLA_Her2k_uh_blk_var7( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C, fla_her2k_t* cntl ) { FLA_Obj AL, AR, A0, A1, A2; FLA_Obj BL, BR, B0, B1, B2; FLA_Obj CTL, CTR, C00, C01, C02, CBL, CBR, C10, C11, C12, C20, C21, C22; dim_t b; FLA_Scalr_internal( FLA_UPPER_TRIANGULAR, beta, C, FLA_Cntl_sub_scalr( cntl ) ); FLA_Part_1x2( A, &AL, &AR, 0, FLA_RIGHT ); FLA_Part_1x2( B, &BL, &BR, 0, FLA_RIGHT ); FLA_Part_2x2( C, &CTL, &CTR, &CBL, &CBR, 0, 0, FLA_BR ); while ( FLA_Obj_width( AR ) < FLA_Obj_width( A ) ){ b = FLA_Determine_blocksize( AL, FLA_LEFT, FLA_Cntl_blocksize( cntl ) ); FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, &A1, /**/ &A2, b, FLA_LEFT ); FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, &B1, /**/ &B2, b, FLA_LEFT ); FLA_Repart_2x2_to_3x3( CTL, /**/ CTR, &C00, &C01, /**/ &C02, &C10, &C11, /**/ &C12, /* ************* */ /* ******************** */ CBL, /**/ CBR, &C20, &C21, /**/ &C22, b, b, FLA_TL ); /*------------------------------------------------------------*/ /* C01 = C01 + B0' * A1 */ FLA_Gemm_internal( FLA_CONJ_TRANSPOSE, FLA_NO_TRANSPOSE, alpha, B0, A1, FLA_ONE, C01, FLA_Cntl_sub_gemm1( cntl ) ); /* C12 = C12 + A1' * B2 */ FLA_Gemm_internal( FLA_CONJ_TRANSPOSE, FLA_NO_TRANSPOSE, alpha, A1, B2, FLA_ONE, C12, FLA_Cntl_sub_gemm2( cntl ) ); /* C11 = C11 + A1' * B1 + B1' * A1 */ FLA_Her2k_internal( FLA_UPPER_TRIANGULAR, FLA_CONJ_TRANSPOSE, alpha, A1, B1, FLA_ONE, C11, FLA_Cntl_sub_her2k( cntl ) ); /*------------------------------------------------------------*/ FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, /**/ A1, A2, FLA_RIGHT ); FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, /**/ B1, B2, FLA_RIGHT ); FLA_Cont_with_3x3_to_2x2( &CTL, /**/ &CTR, C00, /**/ C01, C02, /* ************** */ /* ****************** */ C10, /**/ C11, C12, &CBL, /**/ &CBR, C20, /**/ C21, C22, FLA_BR ); } return FLA_SUCCESS; }
FLA_Error FLA_LU_piv_unb_var3( FLA_Obj A, FLA_Obj p ) { FLA_Obj ATL, ATR, A00, a01, A02, ABL, ABR, a10t, alpha11, a12t, A20, a21, A22; FLA_Obj AL, AR, A0, a1, A2; FLA_Obj pT, p0, pB, pi1, p2; FLA_Obj AB0, aB1; FLA_Part_2x2( A, &ATL, &ATR, &ABL, &ABR, 0, 0, FLA_TL ); FLA_Part_1x2( A, &AL, &AR, 0, FLA_LEFT ); FLA_Part_2x1( p, &pT, &pB, 0, FLA_TOP ); while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) && FLA_Obj_width( ATL ) < FLA_Obj_width( A )){ FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &a01, &A02, /* ************* */ /* ************************** */ &a10t, /**/ &alpha11, &a12t, ABL, /**/ ABR, &A20, /**/ &a21, &A22, 1, 1, FLA_BR ); FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, /**/ &a1, &A2, 1, FLA_RIGHT ); FLA_Repart_2x1_to_3x1( pT, &p0, /* ** */ /* *** */ &pi1, pB, &p2, 1, FLA_BOTTOM ); /*------------------------------------------------------------*/ // Apply previously computed pivots FLA_Apply_pivots( FLA_LEFT, FLA_NO_TRANSPOSE, p0, a1 ); // a01 = trilu( A00 ) \ a01 FLA_Trsv_external( FLA_LOWER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_UNIT_DIAG, A00, a01 ); // alpha11 = alpha11 - a10t * a01 FLA_Dots_external( FLA_MINUS_ONE, a10t, a01, FLA_ONE, alpha11 ); // a21 = a21 - A20 * a01 FLA_Gemv_external( FLA_NO_TRANSPOSE, FLA_MINUS_ONE, A20, a01, FLA_ONE, a21 ); // aB1 = / alpha11 \ // \ a21 / FLA_Merge_2x1( alpha11, a21, &aB1 ); // Determine pivot index FLA_Amax_external( aB1, pi1 ); // Apply pivots to current column FLA_Apply_pivots( FLA_LEFT, FLA_NO_TRANSPOSE, pi1, aB1 ); // a21 = a21 / alpha11 FLA_Inv_scal_external( alpha11, a21 ); // AB0 = / a10t \ // \ A20 / FLA_Merge_2x1( a10t, A20, &AB0 ); // Apply pivots to previous columns FLA_Apply_pivots( FLA_LEFT, FLA_NO_TRANSPOSE, pi1, AB0 ); /*------------------------------------------------------------*/ FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, a01, /**/ A02, a10t, alpha11, /**/ a12t, /* ************** */ /* ************************ */ &ABL, /**/ &ABR, A20, a21, /**/ A22, FLA_TL ); FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, a1, /**/ A2, FLA_LEFT ); FLA_Cont_with_3x1_to_2x1( &pT, p0, pi1, /* ** */ /* *** */ &pB, p2, FLA_TOP ); } if ( FLA_Obj_width( ATR ) > 0 ) { /* Apply pivots to untouched columns */ FLA_Apply_pivots( FLA_LEFT, FLA_NO_TRANSPOSE, p, ATR ); /* ATR = trilu( ATL ) \ ATR */ FLA_Trsm_external( FLA_LEFT, FLA_LOWER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_UNIT_DIAG, FLA_ONE, ATL, ATR ); } return FLA_SUCCESS; }
FLA_Error FLA_Gemm_nn_omp_var15( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj C, fla_gemm_t* cntl ) { FLA_Obj AT, A0, AB, A1, A2; FLA_Obj CT, C0, CB, C1, C2; FLA_Obj AL, AR, A10, A11, A12; FLA_Obj BT, B0, BB, B1, B2; FLA_Obj C1_local; int i, j, lock_ldim, lock_i; int b_m, b_k; FLA_Part_2x1( A, &AT, &AB, 0, FLA_TOP ); FLA_Part_2x1( C, &CT, &CB, 0, FLA_TOP ); #pragma intel omp parallel taskq { while ( FLA_Obj_length( AT ) < FLA_Obj_length( A ) ) { b_m = FLA_Determine_blocksize( A, AT, FLA_TOP, FLA_Cntl_blocksize( cntl ) ); FLA_Repart_2x1_to_3x1( AT, &A0, /* ** */ /* ** */ &A1, AB, &A2, b_m, FLA_BOTTOM ); FLA_Repart_2x1_to_3x1( CT, &C0, /* ** */ /* ** */ &C1, CB, &C2, b_m, FLA_BOTTOM ); /*------------------------------------------------------------*/ /* C1 = alpha * A1 * B + C1; */ FLA_Part_1x2( A1, &AL, &AR, 0, FLA_LEFT ); FLA_Part_2x1( B, &BT, &BB, 0, FLA_TOP ); while ( FLA_Obj_width( AL ) < FLA_Obj_width( A ) ) { b_k = FLA_Determine_blocksize( A, AL, FLA_LEFT, FLA_Cntl_blocksize( cntl ) ); // Get the index of the current partition. // FIX THIS: need + b_m - 1 or something like this //j = FLA_Obj_length( CT ) / b_m; //i = FLA_Obj_width( AL ) / b_k; //lock_ldim = FLA_get_num_threads_in_m_dim(omp_get_num_threads()); lock_i = FLA_Obj_length( CT ) / b_m; FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A10, /**/ &A11, &A12, b_k, FLA_RIGHT ); FLA_Repart_2x1_to_3x1( BT, &B0, /* ** */ /* ** */ &B1, BB, &B2, b_k, FLA_BOTTOM ); /*------------------------------------------------------------*/ /* C1 = alpha * A11 * B1 + C1; */ //// FLA_Gemm( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE, //// alpha, A11, B1, FLA_ONE, C1 ); #pragma intel omp task captureprivate( lock_i, A11, B1, C1 ), private( C1_local ) { FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, C1, &C1_local ); FLA_Obj_set_to_zero( C1_local ); /* C1_local = alpha * A1 * B11 + C1_local; */ FLA_Gemm_external( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE, alpha, A11, B1, FLA_ONE, C1_local ); // Acquire lock[i] (the lock for C1). omp_set_lock( &fla_omp_lock[lock_i] ); /* C1 += C1_local */ FLA_Axpy_external( FLA_ONE, C1_local, C1 ); //FLA_Axpy_sync_pipeline2( j*lock_ldim, FLA_ONE, C1_local, C1 ); //FLA_Axpy_sync_circular2( j*lock_ldim, i, FLA_ONE, C1_local, C1 ); //REF_Axpy_sync_circular2( j*lock_ldim, i, FLA_ONE, C1_local, C1 ); // Release lock[i] (the lock for C1). omp_unset_lock( &fla_omp_lock[lock_i] ); FLA_Obj_free( &C1_local ); } /*------------------------------------------------------------*/ FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A10, A11, /**/ A12, FLA_LEFT ); FLA_Cont_with_3x1_to_2x1( &BT, B0, B1, /* ** */ /* ** */ &BB, B2, FLA_TOP ); } /*------------------------------------------------------------*/ FLA_Cont_with_3x1_to_2x1( &AT, A0, A1, /* ** */ /* ** */ &AB, A2, FLA_TOP ); FLA_Cont_with_3x1_to_2x1( &CT, C0, C1, /* ** */ /* ** */ &CB, C2, FLA_TOP ); } } return FLA_SUCCESS; }
FLA_Error FLA_Her2k_uh_unb_var1( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C ) { FLA_Obj AL, AR, A0, a1, A2; FLA_Obj BL, BR, B0, b1, B2; FLA_Obj CTL, CTR, C00, c01, C02, CBL, CBR, c10t, gamma11, c12t, C20, c21, C22; FLA_Scalr_external( FLA_UPPER_TRIANGULAR, beta, C ); FLA_Part_1x2( A, &AL, &AR, 0, FLA_LEFT ); FLA_Part_1x2( B, &BL, &BR, 0, FLA_LEFT ); FLA_Part_2x2( C, &CTL, &CTR, &CBL, &CBR, 0, 0, FLA_TL ); while ( FLA_Obj_width( AL ) < FLA_Obj_width( A ) ){ FLA_Repart_1x2_to_1x3( AL, /**/ AR, &A0, /**/ &a1, &A2, 1, FLA_RIGHT ); FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, /**/ &b1, &B2, 1, FLA_RIGHT ); FLA_Repart_2x2_to_3x3( CTL, /**/ CTR, &C00, /**/ &c01, &C02, /* ************* */ /* ************************** */ &c10t, /**/ &gamma11, &c12t, CBL, /**/ CBR, &C20, /**/ &c21, &C22, 1, 1, FLA_BR ); /*------------------------------------------------------------*/ /* c12t = c12t + a1' * B2 */ FLA_Gemvc_external( FLA_TRANSPOSE, FLA_CONJUGATE, alpha, B2, a1, FLA_ONE, c12t ); /* c12t = c12t + b1' * A2 */ FLA_Gemvc_external( FLA_TRANSPOSE, FLA_CONJUGATE, alpha, A2, b1, FLA_ONE, c12t ); /* gamma11 = gamma11 + a1' * b1 + b1' * a1 */ FLA_Dot2cs_external( FLA_CONJUGATE, alpha, a1, b1, FLA_ONE, gamma11 ); /*------------------------------------------------------------*/ FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, a1, /**/ A2, FLA_LEFT ); FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, b1, /**/ B2, FLA_LEFT ); FLA_Cont_with_3x3_to_2x2( &CTL, /**/ &CTR, C00, c01, /**/ C02, c10t, gamma11, /**/ c12t, /* ************** */ /* ************************ */ &CBL, /**/ &CBR, C20, c21, /**/ C22, FLA_TL ); } return FLA_SUCCESS; }
FLA_Error FLA_Accum_T_UT_fc_blk_var2( FLA_Obj A, FLA_Obj t, FLA_Obj T ) { FLA_Obj ATL, ATR, A00, A01, A02, ABL, ABR, A10, A11, A12, A20, A21, A22; FLA_Obj tT, t0, tB, t1, t2; FLA_Obj TL, TR, T0, T1, T2; FLA_Obj AB1; dim_t b_alg, b; b_alg = FLA_Obj_length( T ); FLA_Part_2x2( A, &ATL, &ATR, &ABL, &ABR, 0, 0, FLA_TL ); FLA_Part_2x1( t, &tT, &tB, 0, FLA_TOP ); FLA_Part_1x2( T, &TL, &TR, 0, FLA_LEFT ); while ( FLA_Obj_length( tB ) > 0 ) { b = min( FLA_Obj_length( tB ), b_alg ); 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( tT, &t0, /* ** */ /* ** */ &t1, tB, &t2, b, FLA_BOTTOM ); FLA_Repart_1x2_to_1x3( TL, /**/ TR, &T0, /**/ &T1, &T2, b, FLA_RIGHT ); /*------------------------------------------------------------*/ FLA_Merge_2x1( A11, A21, &AB1 ); //FLA_Accum_T_UT_fc_unb_var1( AB1, t1, T1 ); FLA_Accum_T_UT_fc_opt_var1( AB1, t1, T1 ); /*------------------------------------------------------------*/ 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( &tT, t0, t1, /* ** */ /* ** */ &tB, t2, FLA_TOP ); FLA_Cont_with_1x3_to_1x2( &TL, /**/ &TR, T0, T1, /**/ T2, 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_QR_UT_piv_blk_var2( FLA_Obj A, FLA_Obj T, FLA_Obj w, FLA_Obj p, fla_qrut_t* cntl ) { FLA_Obj ATL, ATR, A00, A01, A02, ABL, ABR, A10, A11, A12, A20, A21, A22; FLA_Obj TL, TR, T0, T1, W12; FLA_Obj TT, TB; FLA_Obj pT, p0, pB, p1, p2; FLA_Obj wT, w0, wB, w1, w2; 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( p, &pT, &pB, 0, FLA_TOP ); FLA_Part_2x1( w, &wT, &wB, 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, &W12, b, FLA_RIGHT ); FLA_Repart_2x1_to_3x1( pT, &p0, /* ** */ /* ** */ &p1, pB, &p2, b, FLA_BOTTOM ); FLA_Repart_2x1_to_3x1( wT, &w0, /* ** */ /* ** */ &w1, wB, &w2, b, FLA_BOTTOM ); /*------------------------------------------------------------*/ // ** Reshape T matrices to match the blocksize b FLA_Part_2x1( TR, &TT, &TB, b, FLA_TOP ); // ** Perform a unblocked (BLAS2-oriented) QR factorization // with pivoting via the UT transform on ABR: // // ABR -> QB1 R11 // // where: // - QB1 is formed from UB1 (which is stored column-wise below the // diagonal of ( A11 A21 )^T and the upper-triangle of T1. // - R11 is stored to ( A11 A12 ). // - W12 stores T and partial updates for FLA_Apply_Q_UT_piv_var. FLA_QR_UT_piv_internal( ABR, TT, wB, p1, FLA_Cntl_sub_qrut( cntl ) ); if ( FLA_Obj_width( A12 ) > 0 ) { // ** Block update FLA_Part_2x1( W12, &TT, &TB, b, FLA_TOP ); FLA_Gemm_external( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE, FLA_MINUS_ONE, A21, TT, FLA_ONE, A22 ); } // ** Apply pivots to previous columns. FLA_Apply_pivots( FLA_RIGHT, FLA_TRANSPOSE, p1, ATR ); /*------------------------------------------------------------*/ 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, /**/ W12, FLA_LEFT ); FLA_Cont_with_3x1_to_2x1( &pT, p0, p1, /* ** */ /* ** */ &pB, p2, FLA_TOP ); FLA_Cont_with_3x1_to_2x1( &wT, w0, w1, /* ** */ /* ** */ &wB, w2, FLA_TOP ); } return FLA_SUCCESS; }
FLA_Error FLASH_Axpy_hierarchy( int direction, FLA_Obj alpha, FLA_Obj F, FLA_Obj* H ) { // Once we get down to a submatrix whose elements are scalars, we are down // to our base case. if ( FLA_Obj_elemtype( *H ) == FLA_SCALAR ) { // Depending on which top-level function invoked us, we either axpy // the source data in the flat matrix to the leaf-level submatrix of // the hierarchical matrix, or axpy the data in the hierarchical // submatrix to the flat matrix. if ( direction == FLA_FLAT_TO_HIER ) { #ifdef FLA_ENABLE_SCC if ( FLA_is_owner() ) #endif FLA_Axpy_external( alpha, F, *H ); } else if ( direction == FLA_HIER_TO_FLAT ) { #ifdef FLA_ENABLE_SCC if ( FLA_is_owner() ) #endif FLA_Axpy_external( alpha, *H, F ); } } else { FLA_Obj HL, HR, H0, H1, H2; FLA_Obj FL, FR, F0, F1, F2; FLA_Obj H1T, H01, H1B, H11, H21; FLA_Obj F1T, F01, F1B, F11, F21; dim_t b_m; dim_t b_n; FLA_Part_1x2( *H, &HL, &HR, 0, FLA_LEFT ); FLA_Part_1x2( F, &FL, &FR, 0, FLA_LEFT ); while ( FLA_Obj_width( HL ) < FLA_Obj_width( *H ) ) { FLA_Repart_1x2_to_1x3( HL, /**/ HR, &H0, /**/ &H1, &H2, 1, FLA_RIGHT ); // Get the scalar width of H1 and use that to determine the // width of F1. b_n = FLASH_Obj_scalar_width( H1 ); FLA_Repart_1x2_to_1x3( FL, /**/ FR, &F0, /**/ &F1, &F2, b_n, FLA_RIGHT ); // ------------------------------------------------------------- FLA_Part_2x1( H1, &H1T, &H1B, 0, FLA_TOP ); FLA_Part_2x1( F1, &F1T, &F1B, 0, FLA_TOP ); while ( FLA_Obj_length( H1T ) < FLA_Obj_length( H1 ) ) { FLA_Repart_2x1_to_3x1( H1T, &H01, /* ** */ /* *** */ &H11, H1B, &H21, 1, FLA_BOTTOM ); // Get the scalar length of H11 and use that to determine the // length of F11. b_m = FLASH_Obj_scalar_length( H11 ); FLA_Repart_2x1_to_3x1( F1T, &F01, /* ** */ /* *** */ &F11, F1B, &F21, b_m, FLA_BOTTOM ); // ------------------------------------------------------------- // Recursively axpy between F11 and H11. FLASH_Axpy_hierarchy( direction, alpha, F11, FLASH_OBJ_PTR_AT( H11 ) ); // ------------------------------------------------------------- FLA_Cont_with_3x1_to_2x1( &H1T, H01, H11, /* ** */ /* *** */ &H1B, H21, FLA_TOP ); FLA_Cont_with_3x1_to_2x1( &F1T, F01, F11, /* ** */ /* *** */ &F1B, F21, FLA_TOP ); } // ------------------------------------------------------------- FLA_Cont_with_1x3_to_1x2( &HL, /**/ &HR, H0, H1, /**/ H2, FLA_LEFT ); FLA_Cont_with_1x3_to_1x2( &FL, /**/ &FR, F0, F1, /**/ F2, FLA_LEFT ); } } return FLA_SUCCESS; }
int Symm_ru_unb_var6( FLA_Obj A, FLA_Obj B, FLA_Obj C ) { FLA_Obj ATL, ATR, A00, a01, A02, ABL, ABR, a10t, alpha11, a12t, A20, a21, A22; FLA_Obj BL, BR, B0, b1, B2; FLA_Obj CL, CR, C0, c1, C2; FLA_Part_2x2( A, &ATL, &ATR, &ABL, &ABR, 0, 0, FLA_BR ); FLA_Part_1x2( B, &BL, &BR, 0, FLA_RIGHT ); FLA_Part_1x2( C, &CL, &CR, 0, FLA_RIGHT ); while ( FLA_Obj_length( ABR ) < FLA_Obj_length( A ) ){ FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, &a01, /**/ &A02, &a10t, &alpha11, /**/ &a12t, /* ************* */ /* ************************** */ ABL, /**/ ABR, &A20, &a21, /**/ &A22, 1, 1, FLA_TL ); FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, &b1, /**/ &B2, 1, FLA_LEFT ); FLA_Repart_1x2_to_1x3( CL, /**/ CR, &C0, &c1, /**/ &C2, 1, FLA_LEFT ); /*------------------------------------------------------------*/ /*c1 = B0 * a01 + c1; c1 = SLAP_Gemv_n(1,B0,a01,c1);*/ FLA_Gemv(FLA_NO_TRANSPOSE, FLA_ONE, B0, a01, FLA_ONE, c1); /*c1 = alpha11 * b1 + c1; c1 = SLAP_Axpy(alpha11,b1,c1);*/ FLA_Axpy(alpha11,b1,c1); /*c1 = B2 * a21 + c1; c1 = SLAP_Gemv_n(1,B2,a12,c1);*/ FLA_Gemv(FLA_NO_TRANSPOSE, FLA_ONE, B2, a12t, FLA_ONE, c1); /*------------------------------------------------------------*/ FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, /**/ a01, A02, /* ************** */ /* ************************ */ a10t, /**/ alpha11, a12t, &ABL, /**/ &ABR, A20, /**/ a21, A22, FLA_BR ); FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, /**/ b1, B2, FLA_RIGHT ); FLA_Cont_with_1x3_to_1x2( &CL, /**/ &CR, C0, /**/ c1, C2, FLA_RIGHT ); } return FLA_SUCCESS; }
FLA_Error FLA_Hess_UT_blk_var4( FLA_Obj A, FLA_Obj T ) { FLA_Obj ATL, ATR, A00, A01, A02, ABL, ABR, A10, A11, A12, A20, A21, A22; FLA_Obj UT, U0, UB, U1, U2; FLA_Obj YT, Y0, YB, Y1, Y2; FLA_Obj ZT, Z0, ZB, Z1, Z2; FLA_Obj TL, TR, T0, T1, T2; FLA_Obj U, Y, Z; FLA_Obj ABR_l; FLA_Obj UB_l, U2_l; FLA_Obj YB_l, Y2_l; FLA_Obj ZB_l, Z2_l; FLA_Obj WT_l; FLA_Obj T1_tl; FLA_Obj none, none2, none3; FLA_Obj UB_tl, UB_bl; FLA_Datatype datatype_A; dim_t m_A; dim_t b_alg, b, bb; b_alg = FLA_Obj_length( T ); datatype_A = FLA_Obj_datatype( A ); m_A = FLA_Obj_length( A ); FLA_Obj_create( datatype_A, m_A, b_alg, 0, 0, &U ); FLA_Obj_create( datatype_A, m_A, b_alg, 0, 0, &Y ); FLA_Obj_create( datatype_A, m_A, b_alg, 0, 0, &Z ); FLA_Part_2x2( A, &ATL, &ATR, &ABL, &ABR, 0, 0, FLA_TL ); FLA_Part_2x1( U, &UT, &UB, 0, FLA_TOP ); FLA_Part_2x1( Y, &YT, &YB, 0, FLA_TOP ); FLA_Part_2x1( Z, &ZT, &ZB, 0, FLA_TOP ); FLA_Part_1x2( T, &TL, &TR, 0, FLA_LEFT ); while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ) { b = min( FLA_Obj_length( ABR ), b_alg ); 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( UT, &U0, /* ** */ /* ** */ &U1, UB, &U2, b, FLA_BOTTOM ); FLA_Repart_2x1_to_3x1( YT, &Y0, /* ** */ /* ** */ &Y1, YB, &Y2, b, FLA_BOTTOM ); FLA_Repart_2x1_to_3x1( ZT, &Z0, /* ** */ /* ** */ &Z1, ZB, &Z2, b, FLA_BOTTOM ); FLA_Repart_1x2_to_1x3( TL, /**/ TR, &T0, /**/ &T1, &T2, b, FLA_RIGHT ); /*------------------------------------------------------------*/ FLA_Part_2x2( T1, &T1_tl, &none, &none2, &none3, b, b, FLA_TL ); bb = min( FLA_Obj_length( ABR ) - 1, b_alg ); FLA_Part_1x2( ABR, &ABR_l, &none, bb, FLA_LEFT ); FLA_Part_1x2( UB, &UB_l, &none, bb, FLA_LEFT ); FLA_Part_1x2( YB, &YB_l, &none, bb, FLA_LEFT ); FLA_Part_1x2( ZB, &ZB_l, &none, bb, FLA_LEFT ); FLA_Part_2x1( UB_l, &none, &U2_l, b, FLA_TOP ); FLA_Part_2x1( YB_l, &none, &Y2_l, b, FLA_TOP ); FLA_Part_2x1( ZB_l, &none, &Z2_l, b, FLA_TOP ); // [ ABR, YB, ZB, T1 ] = FLA_Hess_UT_step_unb_var4( ABR, YB, ZB, T1, b ); //FLA_Hess_UT_step_unb_var4( ABR, YB, ZB, T1_tl ); //FLA_Hess_UT_step_ofu_var4( ABR, YB, ZB, T1_tl ); FLA_Hess_UT_step_opt_var4( ABR, YB, ZB, T1_tl ); // Build UB from ABR, with explicit unit subdiagonal and zeros. FLA_Copy_external( ABR_l, UB_l ); FLA_Part_2x1( UB_l, &UB_tl, &UB_bl, 1, FLA_TOP ); FLA_Triangularize( FLA_LOWER_TRIANGULAR, FLA_UNIT_DIAG, UB_bl ); FLA_Set( FLA_ZERO, UB_tl ); // ATR = ATR - ATR * UB * inv( triu( T ) ) * UB' ); if ( FLA_Obj_length( ATR ) > 0 ) { // NOTE: We use ZT as temporary workspace. FLA_Part_1x2( ZT, &WT_l, &none, bb, FLA_LEFT ); FLA_Part_2x2( T1, &T1_tl, &none, &none2, &none3, bb, bb, FLA_TL ); // WT_l = ATR * UB_l * inv( triu( T ) ). FLA_Gemm_external( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE, FLA_ONE, ATR, UB_l, FLA_ZERO, WT_l ); FLA_Trsm_external( FLA_RIGHT, FLA_UPPER_TRIANGULAR, FLA_NO_TRANSPOSE, FLA_NONUNIT_DIAG, FLA_ONE, T1_tl, WT_l ); // ATR = ATR - WT_l * UB_l' FLA_Gemm_external( FLA_NO_TRANSPOSE, FLA_CONJ_TRANSPOSE, FLA_MINUS_ONE, WT_l, UB_l, FLA_ONE, ATR ); } // A22 = A22 - U2 * Y2' - Z2 * U2'; FLA_Gemm_external( FLA_NO_TRANSPOSE, FLA_CONJ_TRANSPOSE, FLA_MINUS_ONE, U2_l, Y2_l, FLA_ONE, A22 ); FLA_Gemm_external( FLA_NO_TRANSPOSE, FLA_CONJ_TRANSPOSE, FLA_MINUS_ONE, Z2_l, U2_l, FLA_ONE, A22 ); /*------------------------------------------------------------*/ 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( &UT, U0, U1, /* ** */ /* ** */ &UB, U2, FLA_TOP ); FLA_Cont_with_3x1_to_2x1( &YT, Y0, Y1, /* ** */ /* ** */ &YB, Y2, FLA_TOP ); FLA_Cont_with_3x1_to_2x1( &ZT, Z0, Z1, /* ** */ /* ** */ &ZB, Z2, FLA_TOP ); FLA_Cont_with_1x3_to_1x2( &TL, /**/ &TR, T0, T1, /**/ T2, FLA_LEFT ); } FLA_Obj_free( &U ); FLA_Obj_free( &Y ); FLA_Obj_free( &Z ); 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_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_Symm_rl_unb_var1( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C ) { FLA_Obj ATL, ATR, A00, a01, A02, ABL, ABR, a10t, alpha11, a12t, A20, a21, A22; FLA_Obj BL, BR, B0, b1t, B2; FLA_Obj CL, CR, C0, c1t, C2; FLA_Scal_external( beta, C ); FLA_Part_2x2( A, &ATL, &ATR, &ABL, &ABR, 0, 0, FLA_TL ); FLA_Part_1x2( B, &BL, &BR, 0, FLA_LEFT ); FLA_Part_1x2( C, &CL, &CR, 0, FLA_LEFT ); while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ){ FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &a01, &A02, /* ************* */ /* ************************** */ &a10t, /**/ &alpha11, &a12t, ABL, /**/ ABR, &A20, /**/ &a21, &A22, 1, 1, FLA_BR ); FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, /**/ &b1t, &B2, 1, FLA_RIGHT ); FLA_Repart_1x2_to_1x3( CL, /**/ CR, &C0, /**/ &c1t, &C2, 1, FLA_RIGHT ); /*------------------------------------------------------------*/ /* C0 = C0 + b1t * a10t */ FLA_Ger_external( alpha, b1t, a10t, C0 ); /* c1t = c1t + B0 * a10t' */ FLA_Gemv_external( FLA_NO_TRANSPOSE, alpha, B0, a10t, FLA_ONE, c1t ); /* c1t = c1t + b1t * alpha11 */ FLA_Axpys_external( alpha, alpha11, b1t, FLA_ONE, c1t ); /*------------------------------------------------------------*/ FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, a01, /**/ A02, a10t, alpha11, /**/ a12t, /* ************** */ /* ************************ */ &ABL, /**/ &ABR, A20, a21, /**/ A22, FLA_TL ); FLA_Cont_with_1x3_to_1x2( &BL, /**/ &BR, B0, b1t, /**/ B2, FLA_LEFT ); FLA_Cont_with_1x3_to_1x2( &CL, /**/ &CR, C0, c1t, /**/ C2, FLA_LEFT ); } return FLA_SUCCESS; }
FLA_Error FLA_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; }