void libfla_test_symm_impl( int impl,
FLA_Side side,
FLA_Uplo uplo,
FLA_Obj alpha,
FLA_Obj A,
FLA_Obj B,
FLA_Obj beta,
FLA_Obj C )
{
switch ( impl )
{
case FLA_TEST_HIER_FRONT_END:
FLASH_Symm( side, uplo, alpha, A, B, beta, C );
break;
case FLA_TEST_FLAT_FRONT_END:
FLA_Symm( side, uplo, alpha, A, B, beta, C );
break;
case FLA_TEST_FLAT_UNB_VAR:
FLA_Symm_internal( side, uplo, alpha, A, B, beta, C, symm_cntl_unb );
break;
case FLA_TEST_FLAT_BLK_VAR:
FLA_Symm_internal( side, uplo, alpha, A, B, beta, C, symm_cntl_blk );
break;
case FLA_TEST_FLAT_UNB_EXT:
FLA_Symm_external( side, uplo, alpha, A, B, beta, C );
break;
default:
libfla_test_output_error( "Invalid implementation type.\n" );
}
}
FLA_Error FLA_Symm_internal( FLA_Side side, FLA_Uplo uplo, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C, fla_symm_t* cntl )
{
FLA_Error r_val = FLA_SUCCESS;
if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
FLA_Symm_internal_check( side, uplo, alpha, A, B, beta, C, 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_Symm_internal( side,
uplo,
alpha,
*FLASH_OBJ_PTR_AT( A ),
*FLASH_OBJ_PTR_AT( B ),
beta,
*FLASH_OBJ_PTR_AT( C ),
flash_symm_cntl_mm );
}
else if ( FLA_Cntl_matrix_type( cntl ) == FLA_HIER &&
FLA_Obj_elemtype( A ) == FLA_SCALAR &&
FLASH_Queue_get_enabled( ) )
{
// Enqueue
ENQUEUE_FLASH_Symm( side, uplo, alpha, A, B, beta, C, cntl );
}
else
{
if ( FLA_Cntl_matrix_type( cntl ) == FLA_HIER &&
FLA_Obj_elemtype( A ) == FLA_SCALAR &&
!FLASH_Queue_get_enabled( ) )
{
// Execute leaf
cntl = flash_symm_cntl_blas;
}
// Parameter combinations
if ( side == FLA_LEFT )
{
if ( uplo == FLA_LOWER_TRIANGULAR )
r_val = FLA_Symm_ll( alpha, A, B, beta, C, cntl );
else if ( uplo == FLA_UPPER_TRIANGULAR )
r_val = FLA_Symm_lu( alpha, A, B, beta, C, cntl );
}
else if ( side == FLA_RIGHT )
{
if ( uplo == FLA_LOWER_TRIANGULAR )
r_val = FLA_Symm_rl( alpha, A, B, beta, C, cntl );
else if ( uplo == FLA_UPPER_TRIANGULAR )
r_val = FLA_Symm_ru( alpha, A, B, beta, C, cntl );
}
}
return r_val;
}
FLA_Error FLA_Symm_rl_blk_var9( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C, fla_symm_t* cntl )
{
FLA_Obj BT, B0,
BB, B1,
B2;
FLA_Obj CT, C0,
CB, C1,
C2;
dim_t b;
FLA_Part_2x1( B, &BT,
&BB, 0, FLA_TOP );
FLA_Part_2x1( C, &CT,
&CB, 0, FLA_TOP );
while ( FLA_Obj_length( BT ) < FLA_Obj_length( B ) ){
b = FLA_Determine_blocksize( BB, FLA_BOTTOM, FLA_Cntl_blocksize( cntl ) );
FLA_Repart_2x1_to_3x1( BT, &B0,
/* ** */ /* ** */
&B1,
BB, &B2, b, FLA_BOTTOM );
FLA_Repart_2x1_to_3x1( CT, &C0,
/* ** */ /* ** */
&C1,
CB, &C2, b, FLA_BOTTOM );
/*------------------------------------------------------------*/
/* C1 = C1 + B1 * A */
FLA_Symm_internal( FLA_RIGHT, FLA_LOWER_TRIANGULAR,
alpha, A, B1, beta, C1,
FLA_Cntl_sub_symm( cntl ) );
/*------------------------------------------------------------*/
FLA_Cont_with_3x1_to_2x1( &BT, B0,
B1,
/* ** */ /* ** */
&BB, B2, FLA_TOP );
FLA_Cont_with_3x1_to_2x1( &CT, C0,
C1,
/* ** */ /* ** */
&CB, C2, FLA_TOP );
}
return FLA_SUCCESS;
}
FLA_Error FLA_Symm( FLA_Side side, FLA_Uplo uplo, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C )
{
FLA_Error r_val = FLA_SUCCESS;
// Check parameters.
if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
FLA_Symm_check( side, uplo, alpha, A, B, beta, C );
#ifdef FLA_ENABLE_BLAS3_FRONT_END_CNTL_TREES
r_val = FLA_Symm_internal( side, uplo, alpha, A, B, beta, C, fla_symm_cntl_mm );
#else
r_val = FLA_Symm_external( side, uplo, alpha, A, B, beta, C );
#endif
return r_val;
}
FLA_Error FLA_Symm_lu_blk_var10( FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C, fla_symm_t* cntl )
{
FLA_Obj BL, BR, B0, B1, B2;
FLA_Obj CL, CR, C0, C1, C2;
dim_t b;
FLA_Part_1x2( B, &BL, &BR, 0, FLA_RIGHT );
FLA_Part_1x2( C, &CL, &CR, 0, FLA_RIGHT );
while ( FLA_Obj_width( BR ) < FLA_Obj_width( B ) ){
b = FLA_Determine_blocksize( BL, FLA_LEFT, FLA_Cntl_blocksize( cntl ) );
FLA_Repart_1x2_to_1x3( BL, /**/ BR, &B0, &B1, /**/ &B2,
b, FLA_LEFT );
FLA_Repart_1x2_to_1x3( CL, /**/ CR, &C0, &C1, /**/ &C2,
b, FLA_LEFT );
/*------------------------------------------------------------*/
/* C1 = C1 + A * B1 */
FLA_Symm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
alpha, A, B1, beta, C1,
FLA_Cntl_sub_symm( cntl ) );
/*------------------------------------------------------------*/
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_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_Symm_lu_blk_var5( 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 BT, B0,
BB, B1,
B2;
FLA_Obj CT, C0,
CB, 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_BR );
FLA_Part_2x1( B, &BT,
&BB, 0, FLA_BOTTOM );
FLA_Part_2x1( C, &CT,
&CB, 0, FLA_BOTTOM );
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_2x1_to_3x1( BT, &B0,
&B1,
/* ** */ /* ** */
BB, &B2, b, FLA_TOP );
FLA_Repart_2x1_to_3x1( CT, &C0,
&C1,
/* ** */ /* ** */
CB, &C2, b, FLA_TOP );
/*------------------------------------------------------------*/
/* C1 = C1 + A11 * B1 */
FLA_Symm_internal( FLA_LEFT, FLA_UPPER_TRIANGULAR,
alpha, A11, B1, FLA_ONE, C1,
FLA_Cntl_sub_symm( cntl ) );
/* C1 = C1 + A12 * B2 */
FLA_Gemm_internal( FLA_NO_TRANSPOSE, FLA_NO_TRANSPOSE,
alpha, A12, B2, FLA_ONE, C1,
FLA_Cntl_sub_gemm1( cntl ) );
/* C2 = C2 + A12' * B1 */
FLA_Gemm_internal( FLA_TRANSPOSE, FLA_NO_TRANSPOSE,
alpha, A12, B1, 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_BR );
FLA_Cont_with_3x1_to_2x1( &BT, B0,
/* ** */ /* ** */
B1,
&BB, B2, FLA_BOTTOM );
FLA_Cont_with_3x1_to_2x1( &CT, C0,
/* ** */ /* ** */
C1,
&CB, C2, FLA_BOTTOM );
}
return FLA_SUCCESS;
}