FLA_Error FLA_Herk_un_unb_var4( FLA_Obj alpha, FLA_Obj A, FLA_Obj beta, FLA_Obj C ) { FLA_Obj AT, A0, AB, a1t, A2; FLA_Obj CTL, CTR, C00, c01, C02, CBL, CBR, c10t, gamma11, c12t, C20, c21, C22; FLA_Scalr_external( FLA_UPPER_TRIANGULAR, beta, C ); FLA_Part_2x1( A, &AT, &AB, 0, FLA_BOTTOM ); FLA_Part_2x2( C, &CTL, &CTR, &CBL, &CBR, 0, 0, FLA_BR ); while ( FLA_Obj_length( AB ) < FLA_Obj_length( A ) ){ FLA_Repart_2x1_to_3x1( AT, &A0, &a1t, /* ** */ /* *** */ AB, &A2, 1, FLA_TOP ); FLA_Repart_2x2_to_3x3( CTL, /**/ CTR, &C00, &c01, /**/ &C02, &c10t, &gamma11, /**/ &c12t, /* ************* */ /* ************************** */ CBL, /**/ CBR, &C20, &c21, /**/ &C22, 1, 1, FLA_TL ); /*------------------------------------------------------------*/ /* c01 = c01 + A0 * a1t' */ FLA_Gemvc_external( FLA_NO_TRANSPOSE, FLA_CONJUGATE, alpha, A0, a1t, FLA_ONE, c01 ); /* gamma11 = gamma11 + a1t * a1t' */ FLA_Dotcs_external( FLA_CONJUGATE, alpha, a1t, a1t, FLA_ONE, gamma11 ); /*------------------------------------------------------------*/ FLA_Cont_with_3x1_to_2x1( &AT, A0, /* ** */ /* *** */ a1t, &AB, A2, FLA_BOTTOM ); FLA_Cont_with_3x3_to_2x2( &CTL, /**/ &CTR, C00, /**/ c01, C02, /* ************** */ /* ************************ */ c10t, /**/ gamma11, c12t, &CBL, /**/ &CBR, C20, /**/ c21, C22, FLA_BR ); } return FLA_SUCCESS; }
FLA_Error FLA_Herk_lh_unb_var1( FLA_Obj alpha, FLA_Obj A, FLA_Obj beta, FLA_Obj C ) { FLA_Obj AL, AR, A0, a1, A2; FLA_Obj CTL, CTR, C00, c01, C02, CBL, CBR, c10t, gamma11, c12t, C20, c21, C22; FLA_Scalr_external( FLA_LOWER_TRIANGULAR, beta, C ); FLA_Part_1x2( A, &AL, &AR, 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_2x2_to_3x3( CTL, /**/ CTR, &C00, /**/ &c01, &C02, /* ************* */ /* ************************** */ &c10t, /**/ &gamma11, &c12t, CBL, /**/ CBR, &C20, /**/ &c21, &C22, 1, 1, FLA_BR ); /*------------------------------------------------------------*/ /* C10 = C10 + A1' * A0 */ /* c10t = c10t + A0' * a1 */ FLA_Gemvc_external( FLA_TRANSPOSE, FLA_CONJUGATE, alpha, A0, a1, FLA_ONE, c10t ); /* gamma11 = gamma11 + a1' * a1 */ FLA_Dotcs_external( FLA_CONJUGATE, alpha, a1, a1, FLA_ONE, gamma11 ); /*------------------------------------------------------------*/ FLA_Cont_with_1x3_to_1x2( &AL, /**/ &AR, A0, a1, /**/ A2, 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_Chol_u_unb_var2( FLA_Obj A ) { FLA_Obj ATL, ATR, A00, a01, A02, ABL, ABR, a10t, alpha11, a12t, A20, a21, A22; int r_val = FLA_SUCCESS; FLA_Part_2x2( A, &ATL, &ATR, &ABL, &ABR, 0, 0, FLA_TL ); while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ){ FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &a01, &A02, /* ************* */ /* ************************** */ &a10t, /**/ &alpha11, &a12t, ABL, /**/ ABR, &A20, /**/ &a21, &A22, 1, 1, FLA_BR ); /*------------------------------------------------------------*/ // alpha11 = alpha11 - a01' * a01 FLA_Dotcs_external( FLA_CONJUGATE, FLA_MINUS_ONE, a01, a01, FLA_ONE, alpha11 ); // a12t = a12t - a01' * A02 // a12t' = a12t' - A02' * conj(a01) FLA_Gemvc_external( FLA_TRANSPOSE, FLA_CONJUGATE, FLA_MINUS_ONE, A02, a01, FLA_ONE, a12t ); // alpha11 = sqrt( alpha11 ) r_val = FLA_Sqrt( alpha11 ); if ( r_val != FLA_SUCCESS ) return ( FLA_Obj_length( A00 ) ); // a12t = a12t / alpha11 FLA_Inv_scal_external( alpha11, a12t ); /*------------------------------------------------------------*/ FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, a01, /**/ A02, a10t, alpha11, /**/ a12t, /* ************** */ /* ************************ */ &ABL, /**/ &ABR, A20, a21, /**/ A22, FLA_TL ); } return r_val; }
FLA_Error FLA_Chol_l_unb_var1( FLA_Obj A ) { FLA_Obj ATL, ATR, A00, a01, A02, ABL, ABR, a10t, alpha11, a12t, A20, a21, A22; int r_val = FLA_SUCCESS; FLA_Part_2x2( A, &ATL, &ATR, &ABL, &ABR, 0, 0, FLA_TL ); while ( FLA_Obj_length( ATL ) < FLA_Obj_length( A ) ){ FLA_Repart_2x2_to_3x3( ATL, /**/ ATR, &A00, /**/ &a01, &A02, /* ************* */ /* ************************** */ &a10t, /**/ &alpha11, &a12t, ABL, /**/ ABR, &A20, /**/ &a21, &A22, 1, 1, FLA_BR ); /*------------------------------------------------------------*/ // a10t = a10t * inv( tril( A00 )' ) // a10t' = inv( conj( tril( A00 ) ) ) * a10t' FLA_Trsv_external( FLA_LOWER_TRIANGULAR, FLA_CONJ_NO_TRANSPOSE, FLA_NONUNIT_DIAG, A00, a10t ); // alpha11 = alpha11 - a10t * a10t' FLA_Dotcs_external( FLA_CONJUGATE, FLA_MINUS_ONE, a10t, a10t, FLA_ONE, alpha11 ); // alpha11 = sqrt( alpha11 ) r_val = FLA_Sqrt( alpha11 ); if ( r_val != FLA_SUCCESS ) return ( FLA_Obj_length( A00 ) ); /*------------------------------------------------------------*/ FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, a01, /**/ A02, a10t, alpha11, /**/ a12t, /* ************** */ /* ************************ */ &ABL, /**/ &ABR, A20, a21, /**/ A22, FLA_TL ); } return r_val; }
FLA_Error FLA_Ttmm_u_unb_var3( FLA_Obj A ) { FLA_Obj ATL, ATR, A00, a01, A02, ABL, ABR, a10t, alpha11, a12t, A20, a21, A22; FLA_Part_2x2( A, &ATL, &ATR, &ABL, &ABR, 0, 0, FLA_TL ); 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 ); /*------------------------------------------------------------*/ // alpha11 = alpha11 * alpha11' FLA_Absolute_square( alpha11 ); // alpha11 = alpha11 + a12t * a12t' FLA_Dotcs_external( FLA_CONJUGATE, FLA_ONE, a12t, a12t, FLA_ONE, alpha11 ); // a12t = a12t * triu( A22 )' // a12t' = triu( A22 ) * a12t' FLA_Trmv_external( FLA_UPPER_TRIANGULAR, FLA_CONJ_NO_TRANSPOSE, FLA_NONUNIT_DIAG, A22, a12t ); /*------------------------------------------------------------*/ FLA_Cont_with_3x3_to_2x2( &ATL, /**/ &ATR, A00, a01, /**/ A02, a10t, alpha11, /**/ a12t, /* ************** */ /* ************************ */ &ABL, /**/ &ABR, A20, a21, /**/ A22, FLA_TL ); } return FLA_SUCCESS; }