FLA_Error FLA_Tridiag_UT_l_step_opt_var2( FLA_Obj A, FLA_Obj T ) { FLA_Datatype datatype; int m_A, m_T; int rs_A, cs_A; int rs_T, cs_T; datatype = FLA_Obj_datatype( A ); m_A = FLA_Obj_length( A ); m_T = FLA_Obj_length( T ); rs_A = FLA_Obj_row_stride( A ); cs_A = FLA_Obj_col_stride( A ); rs_T = FLA_Obj_row_stride( T ); cs_T = FLA_Obj_col_stride( T ); switch ( datatype ) { case FLA_FLOAT: { float* buff_A = FLA_FLOAT_PTR( A ); float* buff_T = FLA_FLOAT_PTR( T ); FLA_Tridiag_UT_l_step_ops_var2( m_A, m_T, buff_A, rs_A, cs_A, buff_T, rs_T, cs_T ); break; } case FLA_DOUBLE: { double* buff_A = FLA_DOUBLE_PTR( A ); double* buff_T = FLA_DOUBLE_PTR( T ); FLA_Tridiag_UT_l_step_opd_var2( m_A, m_T, buff_A, rs_A, cs_A, buff_T, rs_T, cs_T ); break; } case FLA_COMPLEX: { scomplex* buff_A = FLA_COMPLEX_PTR( A ); scomplex* buff_T = FLA_COMPLEX_PTR( T ); FLA_Tridiag_UT_l_step_opc_var2( m_A, m_T, buff_A, rs_A, cs_A, buff_T, rs_T, cs_T ); break; } case FLA_DOUBLE_COMPLEX: { dcomplex* buff_A = FLA_DOUBLE_COMPLEX_PTR( A ); dcomplex* buff_T = FLA_DOUBLE_COMPLEX_PTR( T ); FLA_Tridiag_UT_l_step_opz_var2( m_A, m_T, buff_A, rs_A, cs_A, buff_T, rs_T, cs_T ); break; } } return FLA_SUCCESS; }
FLA_Error FLA_Tridiag_UT_l_step_opz_var2( int m_A, int m_T, dcomplex* buff_A, int rs_A, int cs_A, dcomplex* buff_T, int rs_T, int cs_T ) { dcomplex* buff_2 = FLA_DOUBLE_COMPLEX_PTR( FLA_TWO ); dcomplex* buff_1 = FLA_DOUBLE_COMPLEX_PTR( FLA_ONE ); dcomplex* buff_0 = FLA_DOUBLE_COMPLEX_PTR( FLA_ZERO ); dcomplex* buff_m1 = FLA_DOUBLE_COMPLEX_PTR( FLA_MINUS_ONE ); dcomplex first_elem; dcomplex beta; dcomplex inv_tau11; dcomplex minus_inv_tau11; dcomplex minus_upsilon11, minus_conj_upsilon11; dcomplex minus_zeta11, minus_conj_zeta11; int i; // b_alg = FLA_Obj_length( T ); int b_alg = m_T; // FLA_Obj_create( datatype_A, m_A, 1, 0, 0, &u ); // FLA_Obj_create( datatype_A, m_A, 1, 0, 0, &z ); // FLA_Obj_create( datatype_A, m_A, 1, 0, 0, &w ); dcomplex* buff_u = ( dcomplex* ) FLA_malloc( m_A * sizeof( *buff_A ) ); dcomplex* buff_z = ( dcomplex* ) FLA_malloc( m_A * sizeof( *buff_A ) ); dcomplex* buff_w = ( dcomplex* ) FLA_malloc( m_A * sizeof( *buff_A ) ); int inc_u = 1; int inc_z = 1; int inc_w = 1; // Initialize some variables (only to prevent compiler warnings). first_elem = *buff_0; minus_inv_tau11 = *buff_0; for ( i = 0; i < b_alg; ++i ) { dcomplex* A20 = buff_A + (0 )*cs_A + (i+1)*rs_A; dcomplex* alpha11 = buff_A + (i )*cs_A + (i )*rs_A; dcomplex* a21 = buff_A + (i )*cs_A + (i+1)*rs_A; dcomplex* A22 = buff_A + (i+1)*cs_A + (i+1)*rs_A; dcomplex* t01 = buff_T + (i )*cs_T + (0 )*rs_T; dcomplex* tau11 = buff_T + (i )*cs_T + (i )*rs_T; dcomplex* upsilon11= buff_u + (i )*inc_u; dcomplex* u21 = buff_u + (i+1)*inc_u; dcomplex* zeta11 = buff_z + (i )*inc_z; dcomplex* z21 = buff_z + (i+1)*inc_z; dcomplex* w21 = buff_w + (i+1)*inc_w; dcomplex* a21_t = a21 + (0 )*cs_A + (0 )*rs_A; dcomplex* a21_b = a21 + (0 )*cs_A + (1 )*rs_A; int m_ahead = m_A - i - 1; int m_behind = i; int n_behind = i; /*------------------------------------------------------------*/ if ( m_behind > 0 ) { // FLA_Copy( upsilon11, minus_upsilon11 ); // FLA_Scal( FLA_MINUS_ONE, minus_upsilon11 ); // FLA_Copy( minus_upsilon11, minus_conj_upsilon11 ); bl1_zmult3( buff_m1, upsilon11, &minus_upsilon11 ); bl1_zcopyconj( &minus_upsilon11, &minus_conj_upsilon11 ); // FLA_Copy( zeta11, minus_zeta11 ); // FLA_Scal( FLA_MINUS_ONE, minus_zeta11 ); // FLA_Copy( minus_zeta11, minus_conj_zeta11 ); bl1_zmult3( buff_m1, zeta11, &minus_zeta11 ); bl1_zcopyconj( &minus_zeta11, &minus_conj_zeta11 ); // FLA_Axpyt( FLA_CONJ_NO_TRANSPOSE, minus_upsilon11, zeta11, alpha11 ); // FLA_Axpyt( FLA_CONJ_NO_TRANSPOSE, minus_zeta11, upsilon11, alpha11 ); bl1_zaxpyv( BLIS1_CONJUGATE, 1, &minus_upsilon11, zeta11, 1, alpha11, 1 ); bl1_zaxpyv( BLIS1_CONJUGATE, 1, &minus_zeta11, upsilon11, 1, alpha11, 1 ); // FLA_Axpyt( FLA_NO_TRANSPOSE, minus_conj_zeta11, u21, a21 ); // FLA_Axpyt( FLA_NO_TRANSPOSE, minus_conj_upsilon11, z21, a21 ); bl1_zaxpyv( BLIS1_NO_CONJUGATE, m_ahead, &minus_conj_zeta11, u21, inc_u, a21, rs_A ); bl1_zaxpyv( BLIS1_NO_CONJUGATE, m_ahead, &minus_conj_upsilon11, z21, inc_z, a21, rs_A ); } if ( m_ahead > 0 ) { // FLA_Househ2_UT( FLA_LEFT, // a21_t, // a21_b, tau11 ); FLA_Househ2_UT_l_opz( m_ahead - 1, a21_t, a21_b, rs_A, tau11 ); // FLA_Set( FLA_ONE, inv_tau11 ); // FLA_Inv_scalc( FLA_NO_CONJUGATE, tau11, inv_tau11 ); // FLA_Copy( inv_tau11, minus_inv_tau11 ); // FLA_Scal( FLA_MINUS_ONE, minus_inv_tau11 ); bl1_zdiv3( buff_1, tau11, &inv_tau11 ); bl1_zneg2( &inv_tau11, &minus_inv_tau11 ); // FLA_Copy( a21_t, first_elem ); // FLA_Set( FLA_ONE, a21_t ); first_elem = *a21_t; *a21_t = *buff_1; } if ( m_behind > 0 ) { // FLA_Her2( FLA_LOWER_TRIANGULAR, FLA_MINUS_ONE, u21, z21, A22 ); bl1_zher2( BLIS1_LOWER_TRIANGULAR, BLIS1_NO_CONJUGATE, m_ahead, buff_m1, u21, inc_u, z21, inc_z, A22, rs_A, cs_A ); } if ( m_ahead > 0 ) { // FLA_Hemv( FLA_LOWER_TRIANGULAR, FLA_ONE, A22, a21, FLA_ZERO, w21 ); bl1_zhemv( BLIS1_LOWER_TRIANGULAR, BLIS1_NO_CONJUGATE, m_ahead, buff_1, A22, rs_A, cs_A, a21, rs_A, buff_0, w21, inc_w ); // FLA_Copy( a21, u21 ); // FLA_Copy( w21, z21 ); bl1_zcopyv( BLIS1_NO_CONJUGATE, m_ahead, a21, rs_A, u21, inc_u ); bl1_zcopyv( BLIS1_NO_CONJUGATE, m_ahead, w21, inc_w, z21, inc_z ); // FLA_Dotc( FLA_CONJUGATE, a21, z21, beta ); // FLA_Inv_scal( FLA_TWO, beta ); bl1_zdot( BLIS1_CONJUGATE, m_ahead, a21, rs_A, z21, inc_z, &beta ); bl1_zinvscals( buff_2, &beta ); // FLA_Scal( minus_inv_tau11, beta ); // FLA_Axpy( beta, a21, z21 ); // FLA_Scal( inv_tau11, z21 ); bl1_zscals( &minus_inv_tau11, &beta ); bl1_zaxpyv( BLIS1_NO_CONJUGATE, m_ahead, &beta, a21, rs_A, z21, inc_z ); bl1_zscalv( BLIS1_NO_CONJUGATE, m_ahead, &inv_tau11, z21, inc_z ); // FLA_Gemv( FLA_CONJ_TRANSPOSE, FLA_ONE, A20, a21, FLA_ZERO, t01 ); bl1_zgemv( BLIS1_CONJ_TRANSPOSE, BLIS1_NO_CONJUGATE, m_ahead, n_behind, buff_1, A20, rs_A, cs_A, a21, rs_A, buff_0, t01, rs_T ); // FLA_Copy( first_elem, a21_t ); *a21_t = first_elem; } if ( m_behind + 1 == b_alg && m_ahead > 0 ) { // FLA_Her2( FLA_LOWER_TRIANGULAR, FLA_MINUS_ONE, u21, z21, A22 ); bl1_zher2( BLIS1_LOWER_TRIANGULAR, BLIS1_NO_CONJUGATE, m_ahead, buff_m1, u21, inc_u, z21, inc_z, A22, rs_A, cs_A ); } /*------------------------------------------------------------*/ } // FLA_Obj_free( &u ); // FLA_Obj_free( &z ); // FLA_Obj_free( &w ); FLA_free( buff_u ); FLA_free( buff_z ); FLA_free( buff_w ); return FLA_SUCCESS; }
FLA_Error FLA_Tridiag_apply_Q_external( FLA_Side side, FLA_Uplo uplo, FLA_Trans trans, FLA_Obj A, FLA_Obj t, FLA_Obj B ) { int info = 0; #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES FLA_Datatype datatype; // int m_A, n_A; int m_B, n_B; int cs_A; int cs_B; int k_t; int lwork; char blas_side; char blas_uplo; char blas_trans; FLA_Obj work; int i; //if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) // FLA_Apply_Q_check( side, trans, storev, A, t, B ); if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; datatype = FLA_Obj_datatype( A ); // m_A = FLA_Obj_length( A ); // n_A = FLA_Obj_width( A ); cs_A = FLA_Obj_col_stride( A ); m_B = FLA_Obj_length( B ); n_B = FLA_Obj_width( B ); cs_B = FLA_Obj_col_stride( B ); k_t = FLA_Obj_vector_dim( t ); FLA_Param_map_flame_to_netlib_side( side, &blas_side ); FLA_Param_map_flame_to_netlib_uplo( uplo, &blas_uplo ); FLA_Param_map_flame_to_netlib_trans( trans, &blas_trans ); // Make a workspace query the first time through. This will provide us with // and ideal workspace size based on an internal block size. lwork = -1; FLA_Obj_create( datatype, 1, 1, 0, 0, &work ); for ( i = 0; i < 2; ++i ) { if ( i == 1 ) { // Grab the queried ideal workspace size from the work array, free the // work object, and then re-allocate the workspace with the ideal size. if ( datatype == FLA_FLOAT || datatype == FLA_COMPLEX ) lwork = ( int ) *FLA_FLOAT_PTR( work ); else if ( datatype == FLA_DOUBLE || datatype == FLA_DOUBLE_COMPLEX ) lwork = ( int ) *FLA_DOUBLE_PTR( work ); FLA_Obj_free( &work ); FLA_Obj_create( datatype, lwork, 1, 0, 0, &work ); } switch( datatype ){ case FLA_FLOAT: { float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); float *buff_t = ( float * ) FLA_FLOAT_PTR( t ); float *buff_B = ( float * ) FLA_FLOAT_PTR( B ); float *buff_work = ( float * ) FLA_FLOAT_PTR( work ); F77_sormtr( &blas_side, &blas_uplo, &blas_trans, &m_B, &n_B, buff_A, &cs_A, buff_t, buff_B, &cs_B, buff_work, &lwork, &info ); break; } case FLA_DOUBLE: { double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); double *buff_t = ( double * ) FLA_DOUBLE_PTR( t ); double *buff_B = ( double * ) FLA_DOUBLE_PTR( B ); double *buff_work = ( double * ) FLA_DOUBLE_PTR( work ); F77_dormtr( &blas_side, &blas_uplo, &blas_trans, &m_B, &n_B, buff_A, &cs_A, buff_t, buff_B, &cs_B, buff_work, &lwork, &info ); break; } case FLA_COMPLEX: { scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); scomplex *buff_t = ( scomplex * ) FLA_COMPLEX_PTR( t ); scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B ); scomplex *buff_work = ( scomplex * ) FLA_COMPLEX_PTR( work ); F77_cunmtr( &blas_side, &blas_uplo, &blas_trans, &m_B, &n_B, buff_A, &cs_A, buff_t, buff_B, &cs_B, buff_work, &lwork, &info ); break; } case FLA_DOUBLE_COMPLEX: { dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); dcomplex *buff_t = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( t ); dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B ); dcomplex *buff_work = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( work ); F77_zunmtr( &blas_side, &blas_uplo, &blas_trans, &m_B, &n_B, buff_A, &cs_A, buff_t, buff_B, &cs_B, buff_work, &lwork, &info ); break; } } } FLA_Obj_free( &work ); #else FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED ); #endif return info; }
FLA_Error FLA_Apply_G_rf_asm_var5b( FLA_Obj G, FLA_Obj A ) /* Apply k sets of Givens rotations to a matrix A from the right, where each set takes the form: A := A ( G(n-1,k) ... G(1,k) G(0,k) )' = A G(0,k)' G(1,k)' ... G(n-1,k)' where Gik is the ith Givens rotation formed from the kth set, stored in the (i,k) entries of of C and S: Gik = / gamma_ik -sigma_ik \ \ sigma_ik gamma_ik / -FGVZ */ { FLA_Datatype datatype; int k_G, m_A, n_A; int rs_G, cs_G; int rs_A, cs_A; datatype = FLA_Obj_datatype( A ); k_G = FLA_Obj_width( G ); m_A = FLA_Obj_length( A ); n_A = FLA_Obj_width( A ); rs_G = FLA_Obj_row_stride( G ); cs_G = FLA_Obj_col_stride( G ); rs_A = FLA_Obj_row_stride( A ); cs_A = FLA_Obj_col_stride( A ); switch ( datatype ) { case FLA_FLOAT: { scomplex* buff_G = ( scomplex* ) FLA_COMPLEX_PTR( G ); float* buff_A = ( float* ) FLA_FLOAT_PTR( A ); FLA_Apply_G_rf_ass_var5b( k_G, m_A, n_A, 0, 0, buff_G, rs_G, cs_G, buff_A, rs_A, cs_A ); break; } case FLA_DOUBLE: { dcomplex* buff_G = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( G ); double* buff_A = ( double* ) FLA_DOUBLE_PTR( A ); FLA_Apply_G_rf_asd_var5b( k_G, m_A, n_A, 0, 0, buff_G, rs_G, cs_G, buff_A, rs_A, cs_A ); break; } case FLA_COMPLEX: { scomplex* buff_G = ( scomplex* ) FLA_COMPLEX_PTR( G ); scomplex* buff_A = ( scomplex* ) FLA_COMPLEX_PTR( A ); FLA_Apply_G_rf_asc_var5b( k_G, m_A, n_A, 0, 0, buff_G, rs_G, cs_G, buff_A, rs_A, cs_A ); break; } case FLA_DOUBLE_COMPLEX: { dcomplex* buff_G = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( G ); dcomplex* buff_A = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( A ); FLA_Apply_G_rf_asz_var5b( k_G, m_A, n_A, 0, 0, buff_G, rs_G, cs_G, buff_A, rs_A, cs_A ); break; } } return FLA_SUCCESS; }
FLA_Error FLA_Gemv_external( FLA_Trans transa, FLA_Obj alpha, FLA_Obj A, FLA_Obj x, FLA_Obj beta, FLA_Obj y ) { FLA_Datatype datatype; int m_A, n_A; int rs_A, cs_A; int inc_x; int inc_y; trans1_t blis_transa; conj1_t blis_conjx; if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) FLA_Gemv_check( transa, alpha, A, x, beta, y ); if ( FLA_Obj_has_zero_dim( A ) ) { FLA_Scal_external( beta, y ); return FLA_SUCCESS; } datatype = FLA_Obj_datatype( A ); m_A = FLA_Obj_length( A ); n_A = FLA_Obj_width( A ); rs_A = FLA_Obj_row_stride( A ); cs_A = FLA_Obj_col_stride( A ); inc_x = FLA_Obj_vector_inc( x ); inc_y = FLA_Obj_vector_inc( y ); FLA_Param_map_flame_to_blis_trans( transa, &blis_transa ); FLA_Param_map_flame_to_blis_conj( FLA_NO_CONJUGATE, &blis_conjx ); switch( datatype ){ case FLA_FLOAT: { float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); float *buff_x = ( float * ) FLA_FLOAT_PTR( x ); float *buff_y = ( float * ) FLA_FLOAT_PTR( y ); float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); float *buff_beta = ( float * ) FLA_FLOAT_PTR( beta ); bl1_sgemv( blis_transa, blis_conjx, m_A, n_A, buff_alpha, buff_A, rs_A, cs_A, buff_x, inc_x, buff_beta, buff_y, inc_y ); break; } case FLA_DOUBLE: { double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); double *buff_x = ( double * ) FLA_DOUBLE_PTR( x ); double *buff_y = ( double * ) FLA_DOUBLE_PTR( y ); double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); double *buff_beta = ( double * ) FLA_DOUBLE_PTR( beta ); bl1_dgemv( blis_transa, blis_conjx, m_A, n_A, buff_alpha, buff_A, rs_A, cs_A, buff_x, inc_x, buff_beta, buff_y, inc_y ); break; } case FLA_COMPLEX: { scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); scomplex *buff_x = ( scomplex * ) FLA_COMPLEX_PTR( x ); scomplex *buff_y = ( scomplex * ) FLA_COMPLEX_PTR( y ); scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); scomplex *buff_beta = ( scomplex * ) FLA_COMPLEX_PTR( beta ); bl1_cgemv( blis_transa, blis_conjx, m_A, n_A, buff_alpha, buff_A, rs_A, cs_A, buff_x, inc_x, buff_beta, buff_y, inc_y ); break; } case FLA_DOUBLE_COMPLEX: { dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); dcomplex *buff_x = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x ); dcomplex *buff_y = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y ); dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); dcomplex *buff_beta = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta ); bl1_zgemv( blis_transa, blis_conjx, m_A, n_A, buff_alpha, buff_A, rs_A, cs_A, buff_x, inc_x, buff_beta, buff_y, inc_y ); break; } } return FLA_SUCCESS; }
FLA_Error FLA_Axpy_external( FLA_Obj alpha, FLA_Obj A, FLA_Obj B ) { FLA_Datatype datatype; int m_B, n_B; int rs_A, cs_A; int rs_B, cs_B; trans1_t blis_trans; if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) FLA_Axpy_check( alpha, A, B ); if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; datatype = FLA_Obj_datatype( A ); rs_A = FLA_Obj_row_stride( A ); cs_A = FLA_Obj_col_stride( A ); m_B = FLA_Obj_length( B ); n_B = FLA_Obj_width( B ); rs_B = FLA_Obj_row_stride( B ); cs_B = FLA_Obj_col_stride( B ); if ( FLA_Obj_is_conformal_to( FLA_NO_TRANSPOSE, A, B ) ) FLA_Param_map_flame_to_blis_trans( FLA_NO_TRANSPOSE, &blis_trans ); else // if ( FLA_Obj_is_conformal_to( FLA_TRANSPOSE, A, B ) ) FLA_Param_map_flame_to_blis_trans( FLA_TRANSPOSE, &blis_trans ); switch ( datatype ){ case FLA_FLOAT: { float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); float *buff_B = ( float * ) FLA_FLOAT_PTR( B ); bl1_saxpymt( blis_trans, m_B, n_B, buff_alpha, buff_A, rs_A, cs_A, buff_B, rs_B, cs_B ); break; } case FLA_DOUBLE: { double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); double *buff_B = ( double * ) FLA_DOUBLE_PTR( B ); bl1_daxpymt( blis_trans, m_B, n_B, buff_alpha, buff_A, rs_A, cs_A, buff_B, rs_B, cs_B ); break; } case FLA_COMPLEX: { scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B ); bl1_caxpymt( blis_trans, m_B, n_B, buff_alpha, buff_A, rs_A, cs_A, buff_B, rs_B, cs_B ); break; } case FLA_DOUBLE_COMPLEX: { dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B ); bl1_zaxpymt( blis_trans, m_B, n_B, buff_alpha, buff_A, rs_A, cs_A, buff_B, rs_B, cs_B ); break; } } return FLA_SUCCESS; }
FLA_Error FLA_Trsmsx_external( FLA_Side side, FLA_Uplo uplo, FLA_Trans trans, FLA_Diag diag, FLA_Obj alpha, FLA_Obj A, FLA_Obj B, FLA_Obj beta, FLA_Obj C ) { FLA_Datatype datatype; int m_B, n_B; int rs_A, cs_A; int rs_B, cs_B; int rs_C, cs_C; side_t blis_side; uplo_t blis_uplo; trans_t blis_trans; diag_t blis_diag; if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) FLA_Trsmsx_check( side, uplo, trans, diag, alpha, A, B, beta, C ); if ( FLA_Obj_has_zero_dim( B ) ) return FLA_SUCCESS; datatype = FLA_Obj_datatype( A ); rs_A = FLA_Obj_row_stride( A ); cs_A = FLA_Obj_col_stride( A ); m_B = FLA_Obj_length( B ); n_B = FLA_Obj_width( B ); rs_B = FLA_Obj_row_stride( B ); cs_B = FLA_Obj_col_stride( B ); rs_C = FLA_Obj_row_stride( C ); cs_C = FLA_Obj_col_stride( C ); FLA_Param_map_flame_to_blis_side( side, &blis_side ); FLA_Param_map_flame_to_blis_uplo( uplo, &blis_uplo ); FLA_Param_map_flame_to_blis_trans( trans, &blis_trans ); FLA_Param_map_flame_to_blis_diag( diag, &blis_diag ); switch( datatype ){ case FLA_FLOAT: { float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); float *buff_B = ( float * ) FLA_FLOAT_PTR( B ); float *buff_C = ( float * ) FLA_FLOAT_PTR( C ); float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); float *buff_beta = ( float * ) FLA_FLOAT_PTR( beta ); bli_strsmsx( blis_side, blis_uplo, blis_trans, blis_diag, m_B, n_B, buff_alpha, buff_A, rs_A, cs_A, buff_B, rs_B, cs_B, buff_beta, buff_C, rs_C, cs_C ); break; } case FLA_DOUBLE: { double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); double *buff_B = ( double * ) FLA_DOUBLE_PTR( B ); double *buff_C = ( double * ) FLA_DOUBLE_PTR( C ); double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); double *buff_beta = ( double * ) FLA_DOUBLE_PTR( beta ); bli_dtrsmsx( blis_side, blis_uplo, blis_trans, blis_diag, m_B, n_B, buff_alpha, buff_A, rs_A, cs_A, buff_B, rs_B, cs_B, buff_beta, buff_C, rs_C, cs_C ); break; } case FLA_COMPLEX: { scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B ); scomplex *buff_C = ( scomplex * ) FLA_COMPLEX_PTR( C ); scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); scomplex *buff_beta = ( scomplex * ) FLA_COMPLEX_PTR( beta ); bli_ctrsmsx( blis_side, blis_uplo, blis_trans, blis_diag, m_B, n_B, buff_alpha, buff_A, rs_A, cs_A, buff_B, rs_B, cs_B, buff_beta, buff_C, rs_C, cs_C ); break; } case FLA_DOUBLE_COMPLEX: { dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B ); dcomplex *buff_C = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( C ); dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); dcomplex *buff_beta = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta ); bli_ztrsmsx( blis_side, blis_uplo, blis_trans, blis_diag, m_B, n_B, buff_alpha, buff_A, rs_A, cs_A, buff_B, rs_B, cs_B, buff_beta, buff_C, rs_C, cs_C ); break; } } return FLA_SUCCESS; }
FLA_Error FLA_Symv_external( FLA_Uplo uplo, FLA_Obj alpha, FLA_Obj A, FLA_Obj x, FLA_Obj beta, FLA_Obj y ) { FLA_Datatype datatype; int m_A; int rs_A, cs_A; int inc_x; int inc_y; uplo1_t blis_uplo; if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) FLA_Symv_check( uplo, alpha, A, x, beta, y ); if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; datatype = FLA_Obj_datatype( A ); m_A = FLA_Obj_length( A ); rs_A = FLA_Obj_row_stride( A ); cs_A = FLA_Obj_col_stride( A ); inc_x = FLA_Obj_vector_inc( x ); inc_y = FLA_Obj_vector_inc( y ); FLA_Param_map_flame_to_blis_uplo( uplo, &blis_uplo ); switch( datatype ){ case FLA_FLOAT: { float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); float *buff_x = ( float * ) FLA_FLOAT_PTR( x ); float *buff_y = ( float * ) FLA_FLOAT_PTR( y ); float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); float *buff_beta = ( float * ) FLA_FLOAT_PTR( beta ); bl1_ssymv( blis_uplo, m_A, buff_alpha, buff_A, rs_A, cs_A, buff_x, inc_x, buff_beta, buff_y, inc_y ); break; } case FLA_DOUBLE: { double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); double *buff_x = ( double * ) FLA_DOUBLE_PTR( x ); double *buff_y = ( double * ) FLA_DOUBLE_PTR( y ); double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); double *buff_beta = ( double * ) FLA_DOUBLE_PTR( beta ); bl1_dsymv( blis_uplo, m_A, buff_alpha, buff_A, rs_A, cs_A, buff_x, inc_x, buff_beta, buff_y, inc_y ); break; } case FLA_COMPLEX: { scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); scomplex *buff_x = ( scomplex * ) FLA_COMPLEX_PTR( x ); scomplex *buff_y = ( scomplex * ) FLA_COMPLEX_PTR( y ); scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); scomplex *buff_beta = ( scomplex * ) FLA_COMPLEX_PTR( beta ); bl1_csymv( blis_uplo, m_A, buff_alpha, buff_A, rs_A, cs_A, buff_x, inc_x, buff_beta, buff_y, inc_y ); break; } case FLA_DOUBLE_COMPLEX: { dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); dcomplex *buff_x = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x ); dcomplex *buff_y = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y ); dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); dcomplex *buff_beta = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta ); bl1_zsymv( blis_uplo, m_A, buff_alpha, buff_A, rs_A, cs_A, buff_x, inc_x, buff_beta, buff_y, inc_y ); break; } } return FLA_SUCCESS; }
FLA_Error FLA_Sylv_nn_opt_var1( FLA_Obj isgn, FLA_Obj A, FLA_Obj B, FLA_Obj C, FLA_Obj scale ) { FLA_Datatype datatype; int m_C, n_C; int rs_A, cs_A; int rs_B, cs_B; int rs_C, cs_C; int info; datatype = FLA_Obj_datatype( A ); rs_A = FLA_Obj_row_stride( A ); cs_A = FLA_Obj_col_stride( A ); rs_B = FLA_Obj_row_stride( B ); cs_B = FLA_Obj_col_stride( B ); m_C = FLA_Obj_length( C ); n_C = FLA_Obj_width( C ); rs_C = FLA_Obj_row_stride( C ); cs_C = FLA_Obj_col_stride( C ); switch ( datatype ) { case FLA_FLOAT: { int* buff_isgn = FLA_INT_PTR( isgn ); float* buff_A = FLA_FLOAT_PTR( A ); float* buff_B = FLA_FLOAT_PTR( B ); float* buff_C = FLA_FLOAT_PTR( C ); float* buff_scale = FLA_FLOAT_PTR( scale ); float sgn = ( float ) *buff_isgn; FLA_Sylv_nn_ops_var1( sgn, m_C, n_C, buff_A, rs_A, cs_A, buff_B, rs_B, cs_B, buff_C, rs_C, cs_C, buff_scale, &info ); break; } case FLA_DOUBLE: { int* buff_isgn = FLA_INT_PTR( isgn ); double* buff_A = FLA_DOUBLE_PTR( A ); double* buff_B = FLA_DOUBLE_PTR( B ); double* buff_C = FLA_DOUBLE_PTR( C ); double* buff_scale = FLA_DOUBLE_PTR( scale ); double sgn = ( double ) *buff_isgn; FLA_Sylv_nn_opd_var1( sgn, m_C, n_C, buff_A, rs_A, cs_A, buff_B, rs_B, cs_B, buff_C, rs_C, cs_C, buff_scale, &info ); break; } case FLA_COMPLEX: { int* buff_isgn = FLA_INT_PTR( isgn ); scomplex* buff_A = FLA_COMPLEX_PTR( A ); scomplex* buff_B = FLA_COMPLEX_PTR( B ); scomplex* buff_C = FLA_COMPLEX_PTR( C ); scomplex* buff_scale = FLA_COMPLEX_PTR( scale ); float sgn = ( float ) *buff_isgn; FLA_Sylv_nn_opc_var1( sgn, m_C, n_C, buff_A, rs_A, cs_A, buff_B, rs_B, cs_B, buff_C, rs_C, cs_C, buff_scale, &info ); break; } case FLA_DOUBLE_COMPLEX: { int* buff_isgn = FLA_INT_PTR( isgn ); dcomplex* buff_A = FLA_DOUBLE_COMPLEX_PTR( A ); dcomplex* buff_B = FLA_DOUBLE_COMPLEX_PTR( B ); dcomplex* buff_C = FLA_DOUBLE_COMPLEX_PTR( C ); dcomplex* buff_scale = FLA_DOUBLE_COMPLEX_PTR( scale ); double sgn = ( double ) *buff_isgn; FLA_Sylv_nn_opz_var1( sgn, m_C, n_C, buff_A, rs_A, cs_A, buff_B, rs_B, cs_B, buff_C, rs_C, cs_C, buff_scale, &info ); break; } } return FLA_SUCCESS; }