void bli_csyr_blas( uplo_t uplo, int m, scomplex* alpha, scomplex* x, int incx, scomplex* a, int lda )
{
scomplex* x_copy;
scomplex beta;
int k = 1;
int ldx = m;
#ifdef BLIS_ENABLE_CBLAS_INTERFACES
enum CBLAS_ORDER cblas_order = CblasColMajor;
enum CBLAS_UPLO cblas_uplo;
enum CBLAS_TRANSPOSE cblas_trans;
bli_param_map_to_netlib_uplo( uplo, &cblas_uplo );
bli_param_map_to_netlib_trans( BLIS_NO_TRANSPOSE, &cblas_trans );
x_copy = bli_callocv( m );
bli_ccopyv( BLIS_NO_CONJUGATE,
m,
x, incx,
x_copy, 1 );
beta.real = 1.0;
beta.imag = 0.0;
cblas_csyrk( cblas_order,
cblas_uplo,
cblas_trans,
m,
k,
alpha,
x_copy, ldx,
&beta,
a, lda );
bli_cfree( x_copy );
#else
char blas_uplo;
char blas_trans;
bli_param_map_to_netlib_uplo( uplo, &blas_uplo );
bli_param_map_to_netlib_trans( BLIS_NO_TRANSPOSE, &blas_trans );
x_copy = bli_callocv( m );
bli_ccopyv( BLIS_NO_CONJUGATE,
m,
x, incx,
x_copy, 1 );
beta.real = 1.0;
beta.imag = 0.0;
F77_csyrk ( &blas_uplo,
&blas_trans,
&m,
&k,
alpha,
x_copy, &ldx,
&beta,
a, &lda );
bli_cfree( x_copy );
#endif
}
void cblas_csyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
const void *alpha, const void *A, const int lda,
const void *beta, void *C, const int ldc)
{
char UL, TR;
#ifdef F77_CHAR
F77_CHAR F77_TR, F77_UL;
#else
#define F77_TR &TR
#define F77_UL &UL
#endif
#ifdef F77_INT
F77_INT F77_N=N, F77_K=K, F77_lda=lda;
F77_INT F77_ldc=ldc;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_ldc ldc
#endif
extern int CBLAS_CallFromC;
extern int RowMajorStrg;
RowMajorStrg = 0;
CBLAS_CallFromC = 1;
if( Order == CblasColMajor )
{
if( Uplo == CblasUpper) UL='U';
else if ( Uplo == CblasLower ) UL='L';
else
{
cblas_xerbla(2, "cblas_csyrk", "Illegal Uplo setting, %d\n", Uplo);
CBLAS_CallFromC = 0;
RowMajorStrg = 0;
return;
}
if( Trans == CblasTrans) TR ='T';
else if ( Trans == CblasConjTrans ) TR='C';
else if ( Trans == CblasNoTrans ) TR='N';
else
{
cblas_xerbla(3, "cblas_csyrk", "Illegal Trans setting, %d\n", Trans);
CBLAS_CallFromC = 0;
RowMajorStrg = 0;
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_csyrk(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
beta, C, &F77_ldc);
} else if (Order == CblasRowMajor)
{
RowMajorStrg = 1;
if( Uplo == CblasUpper) UL='L';
else if ( Uplo == CblasLower ) UL='U';
else
{
cblas_xerbla(3, "cblas_csyrk", "Illegal Uplo setting, %d\n", Uplo);
CBLAS_CallFromC = 0;
RowMajorStrg = 0;
return;
}
if( Trans == CblasTrans) TR ='N';
else if ( Trans == CblasConjTrans ) TR='N';
else if ( Trans == CblasNoTrans ) TR='T';
else
{
cblas_xerbla(3, "cblas_csyrk", "Illegal Trans setting, %d\n", Trans);
CBLAS_CallFromC = 0;
RowMajorStrg = 0;
return;
}
#ifdef F77_CHAR
F77_UL = C2F_CHAR(&UL);
F77_TR = C2F_CHAR(&TR);
#endif
F77_csyrk(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda,
beta, C, &F77_ldc);
}
else cblas_xerbla(1, "cblas_csyrk", "Illegal Order setting, %d\n", Order);
CBLAS_CallFromC = 0;
RowMajorStrg = 0;
return;
}