void bli_zccopyv( conj_t conj, int m, dcomplex* x, int incx, scomplex* y, int incy )
{
dcomplex* chi;
scomplex* psi;
int i;
// Return early if possible.
if ( bli_zero_dim1( m ) ) return;
// Initialize pointers.
chi = x;
psi = y;
for ( i = 0; i < m; ++i )
{
psi->real = chi->real;
psi->imag = chi->imag;
chi += incx;
psi += incy;
}
if ( bli_is_conj( conj ) )
bli_cconjv( m,
y, incy );
}
void bli_her2_int_check( conj_t conjh,
obj_t* alpha,
obj_t* x,
obj_t* y,
obj_t* c,
her2_t* cntl )
{
err_t e_val;
// Check basic properties of the operation.
bli_her2_basic_check( conjh, alpha, x, y, c );
// Check matrix structure.
if ( bli_is_conj( conjh ) )
{
e_val = bli_check_hermitian_object( c );
bli_check_error_code( e_val );
}
else
{
e_val = bli_check_symmetric_object( c );
bli_check_error_code( e_val );
}
// Check control tree pointer
e_val = bli_check_valid_cntl( ( void* )cntl );
bli_check_error_code( e_val );
}
void bli_zdot( conj_t conj, int n, dcomplex* x, int incx, dcomplex* y, int incy, dcomplex* rho )
{
#ifdef BLIS_ENABLE_CBLAS_INTERFACES
if ( bli_is_conj( conj ) )
{
cblas_zdotc_sub( n,
x, incx,
y, incy,
rho );
}
else // if ( !bli_is_conj( conj ) )
{
cblas_zdotu_sub( n,
x, incx,
y, incy,
rho );
}
#else
bli_zdot_in( conj,
n,
x, incx,
y, incy,
rho );
#endif
}
void bli_cewinvscalv( conj_t conj, int n, scomplex* x, int incx, scomplex* y, int incy )
{
scomplex* chi;
scomplex* psi;
scomplex conjchi;
int i;
if ( bli_is_conj( conj ) )
{
for ( i = 0; i < n; ++i )
{
chi = x + i*incx;
psi = y + i*incy;
bli_ccopyconj( chi, &conjchi );
bli_cinvscals( &conjchi, psi );
}
}
else
{
for ( i = 0; i < n; ++i )
{
chi = x + i*incx;
psi = y + i*incy;
bli_cinvscals( chi, psi );
}
}
}
void bli_zcopyv( conj_t conj, int m, dcomplex* x, int incx, dcomplex* y, int incy )
{
// Return early if possible.
if ( bli_zero_dim1( m ) ) return;
bli_zcopy( m,
x, incx,
y, incy );
if ( bli_is_conj( conj ) )
bli_zconjv( m,
y, incy );
}
void bli_zdot_in( conj_t conj, int n, dcomplex* x, int incx, dcomplex* y, int incy, dcomplex* rho )
{
dcomplex* xip;
dcomplex* yip;
dcomplex xi;
dcomplex yi;
dcomplex rho_temp;
int i;
rho_temp.real = 0.0;
rho_temp.imag = 0.0;
xip = x;
yip = y;
if ( bli_is_conj( conj ) )
{
for ( i = 0; i < n; ++i )
{
xi.real = xip->real;
xi.imag = xip->imag;
yi.real = yip->real;
yi.imag = yip->imag;
rho_temp.real += xi.real * yi.real - -xi.imag * yi.imag;
rho_temp.imag += xi.real * yi.imag + -xi.imag * yi.real;
xip += incx;
yip += incy;
}
}
else // if ( !bli_is_conj( conj ) )
{
for ( i = 0; i < n; ++i )
{
xi.real = xip->real;
xi.imag = xip->imag;
yi.real = yip->real;
yi.imag = yip->imag;
rho_temp.real += xi.real * yi.real - xi.imag * yi.imag;
rho_temp.imag += xi.real * yi.imag + xi.imag * yi.real;
xip += incx;
yip += incy;
}
}
rho->real = rho_temp.real;
rho->imag = rho_temp.imag;
}
void bli_hemv_int_check( conj_t conjh,
obj_t* alpha,
obj_t* a,
obj_t* x,
obj_t* beta,
obj_t* y,
hemv_t* cntl )
{
err_t e_val;
// Check basic properties of the operation.
bli_hemv_basic_check( alpha, a, x, beta, y );
// Check matrix structure.
if ( bli_is_conj( conjh ) )
{
e_val = bli_check_hermitian_object( a );
bli_check_error_code( e_val );
}
else
{
e_val = bli_check_symmetric_object( a );
bli_check_error_code( e_val );
}
// Check object buffers (for non-NULLness).
e_val = bli_check_object_buffer( alpha );
bli_check_error_code( e_val );
e_val = bli_check_object_buffer( a );
bli_check_error_code( e_val );
e_val = bli_check_object_buffer( x );
bli_check_error_code( e_val );
e_val = bli_check_object_buffer( beta );
bli_check_error_code( e_val );
e_val = bli_check_object_buffer( y );
bli_check_error_code( e_val );
// Check control tree pointer.
e_val = bli_check_valid_cntl( ( void* )cntl );
bli_check_error_code( e_val );
}
void bli_her2_int( conj_t conjh,
obj_t* alpha,
obj_t* alpha_conj,
obj_t* x,
obj_t* y,
obj_t* c,
cntx_t* cntx,
her2_t* cntl )
{
varnum_t n;
impl_t i;
FUNCPTR_T f;
obj_t alpha_local;
obj_t alpha_conj_local;
obj_t x_local;
obj_t y_local;
obj_t c_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
{
if ( bli_is_conj( conjh ) ) bli_her2_check( alpha, x, y, c );
else bli_syr2_check( alpha, x, y, c );
}
// If C, x, or y has a zero dimension, return early.
if ( bli_obj_has_zero_dim( c ) ) return;
if ( bli_obj_has_zero_dim( x ) ) return;
if ( bli_obj_has_zero_dim( y ) ) return;
// Alias the operands in case we need to apply conjugations.
bli_obj_alias_to( x, &x_local );
bli_obj_alias_to( y, &y_local );
bli_obj_alias_to( c, &c_local );
// If matrix C is marked for conjugation, we interpret this as a request
// to apply a conjugation to the other operands.
if ( bli_obj_has_conj( &c_local ) )
{
bli_obj_toggle_conj( &c_local );
bli_obj_toggle_conj( &x_local );
bli_obj_toggle_conj( &y_local );
bli_obj_scalar_init_detached_copy_of( bli_obj_dt( alpha ),
BLIS_CONJUGATE,
alpha,
&alpha_local );
bli_obj_scalar_init_detached_copy_of( bli_obj_dt( alpha_conj ),
BLIS_CONJUGATE,
alpha_conj,
&alpha_conj_local );
}
else
{
bli_obj_alias_to( *alpha, alpha_local );
bli_obj_alias_to( *alpha_conj, alpha_conj_local );
}
// Extract the variant number and implementation type.
n = bli_cntl_var_num( cntl );
i = bli_cntl_impl_type( cntl );
// Index into the variant array to extract the correct function pointer.
f = vars[n][i];
// Invoke the variant.
f( conjh,
&alpha_local,
&alpha_conj_local,
&x_local,
&y_local,
&c_local,
cntx,
cntl );
}
void bli_hemv_int( conj_t conjh,
obj_t* alpha,
obj_t* a,
obj_t* x,
obj_t* beta,
obj_t* y,
cntx_t* cntx,
hemv_t* cntl )
{
varnum_t n;
impl_t i;
FUNCPTR_T f;
obj_t a_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
{
if ( bli_is_conj( conjh ) ) bli_hemv_check( alpha, a, x, beta, y );
else bli_symv_check( alpha, a, x, beta, y );
}
// If y has a zero dimension, return early.
if ( bli_obj_has_zero_dim( *y ) ) return;
// If x has a zero dimension, scale y by beta and return early.
if ( bli_obj_has_zero_dim( *x ) )
{
bli_scalm( beta, y );
return;
}
// Alias A in case we need to induce the upper triangular case.
bli_obj_alias_to( *a, a_local );
/*
// Our blocked algorithms only [explicitly] implement the lower triangular
// case, so if matrix A is stored as upper triangular, we must toggle the
// transposition (and conjugation) bits so that the diagonal partitioning
// routines grab the correct partitions corresponding to the upper
// triangular case. But we only need to do this for blocked algorithms,
// since unblocked algorithms are responsible for handling the upper case
// explicitly (and they should not be inspecting the transposition bit anyway).
if ( bli_cntl_is_blocked( cntl ) && bli_obj_is_upper( *a ) )
{
bli_obj_toggle_conj( a_local );
bli_obj_toggle_trans( a_local );
}
*/
// Extract the variant number and implementation type.
n = bli_cntl_var_num( cntl );
i = bli_cntl_impl_type( cntl );
// Index into the variant array to extract the correct function pointer.
f = vars[n][i];
// Invoke the variant.
f( conjh,
alpha,
&a_local,
x,
beta,
y,
cntx,
cntl );
}
