static int check_solution(PLASMA_enum uplo, PLASMA_enum trans, int N, int K,
PLASMA_Complex64_t alpha, PLASMA_Complex64_t *A, int LDA,
PLASMA_Complex64_t *B, int LDB,
double beta, PLASMA_Complex64_t *Cref, PLASMA_Complex64_t *Cplasma, int LDC)
{
int info_solution;
double Anorm, Bnorm, Cinitnorm, Cplasmanorm, Clapacknorm, Rnorm, result;
double eps;
PLASMA_Complex64_t beta_const;
double *work = (double *)malloc(max(N, K)* sizeof(double));
beta_const = -1.0;
Anorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, lapack_const(PlasmaInfNorm),
(trans == PlasmaNoTrans) ? N : K,
(trans == PlasmaNoTrans) ? K : N, A, LDA, work);
Bnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, lapack_const(PlasmaInfNorm),
(trans == PlasmaNoTrans) ? N : K,
(trans == PlasmaNoTrans) ? K : N, B, LDB, work);
Cinitnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, lapack_const(PlasmaInfNorm), N, N, Cref, LDC, work);
Cplasmanorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, lapack_const(PlasmaInfNorm), N, N, Cplasma, LDC, work);
cblas_zher2k(CblasColMajor, (CBLAS_UPLO)uplo, (CBLAS_TRANSPOSE)trans,
N, K, CBLAS_SADDR(alpha), A, LDA, B, LDB, (beta), Cref, LDC);
Clapacknorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, lapack_const(PlasmaInfNorm), N, N, Cref, LDC, work);
cblas_zaxpy(LDC*N, CBLAS_SADDR(beta_const), Cplasma, 1, Cref, 1);
Rnorm = LAPACKE_zlange_work(LAPACK_COL_MAJOR, lapack_const(PlasmaInfNorm), N, N, Cref, LDC, work);
eps = LAPACKE_dlamch_work('e');
printf("Rnorm %e, Anorm %e, Cinitnorm %e, Cplasmanorm %e, Clapacknorm %e\n",
Rnorm, Anorm, Cinitnorm, Cplasmanorm, Clapacknorm);
result = Rnorm / ((Anorm + Bnorm + Cinitnorm) * N * eps);
printf("============\n");
printf("Checking the norm of the difference against reference ZHER2K \n");
printf("-- ||Cplasma - Clapack||_oo/((||A||_oo+||C||_oo).N.eps) = %e \n", result);
if ( isnan(Rnorm) || isinf(Rnorm) || isnan(result) || isinf(result) || (result > 10.0) ) {
printf("-- The solution is suspicious ! \n");
info_solution = 1;
}
else {
printf("-- The solution is CORRECT ! \n");
info_solution= 0 ;
}
free(work);
return info_solution;
}
inline
void her2k (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo,
CBLAS_TRANSPOSE const Trans, int const N, int const K,
traits::complex_d const& alpha,
traits::complex_d const* A, int const lda,
traits::complex_d const* B, int const ldb,
double beta, traits::complex_d* C, int const ldc)
{
cblas_zher2k (Order, Uplo, Trans, N, K,
static_cast<void const*> (&alpha),
static_cast<void const*> (A), lda,
static_cast<void const*> (B), ldb,
beta, static_cast<void*> (C), ldc);
}
// --------------------
magma_err_t
magma_zher2k(
magma_uplo_t uplo, magma_trans_t trans,
magma_int_t n, magma_int_t k,
magmaDoubleComplex alpha, magmaDoubleComplex_const_ptr dA, size_t dA_offset, magma_int_t lda,
magmaDoubleComplex_const_ptr dB, size_t dB_offset, magma_int_t ldb,
double beta, magmaDoubleComplex_ptr dC, size_t dC_offset, magma_int_t ldc,
magma_queue_t queue)
{ // cblas wrapper
magma_int_t ka, kb;
if(trans == MagmaNoTrans){
ka = k;
kb = k;
}else{
ka = n;
kb = n;
}
magmaDoubleComplex *hA, *hB, *hC;
hA = (magmaDoubleComplex*)malloc(lda*ka*sizeof(magmaDoubleComplex));
hB = (magmaDoubleComplex*)malloc(ldb*kb*sizeof(magmaDoubleComplex));
hC = (magmaDoubleComplex*)malloc(ldc*n*sizeof(magmaDoubleComplex));
magma_zgetmatrix(lda, ka, dA, dA_offset, lda, hA, 0, lda, queue);
magma_zgetmatrix(ldb, kb, dB, dB_offset, ldb, hB, 0, ldb, queue);
magma_zgetmatrix(ldc, n, dC, dC_offset, ldc, hC, 0, ldc, queue);
#if defined(PRECISION_z) || defined(PRECISION_c)
cblas_zher2k(CblasColMajor, cblas_uplo_const(uplo), cblas_trans_const(trans),
n, k, (void*)&alpha, hA, lda, hB, ldb, beta, hC, ldc);
#else
cblas_zher2k(CblasColMajor, cblas_uplo_const(uplo), cblas_trans_const(trans),
n, k, alpha, hA, lda, hB, ldb, beta, hC, ldc);
#endif
magma_zsetmatrix(ldc, n, hC, 0, ldc, dC, dC_offset, ldc, queue);
free(hA);
free(hB);
free(hC);
return CL_SUCCESS;
}
void
test_her2k (void) {
const double flteps = 1e-4, dbleps = 1e-6;
{
int order = 101;
int uplo = 121;
int trans = 111;
int N = 1;
int K = 2;
float alpha[2] = {-1.0f, 0.0f};
float beta = -0.3f;
float A[] = { 0.178f, 0.545f, -0.491f, 0.979f };
int lda = 2;
float B[] = { -0.665f, -0.531f, -0.4f, 0.227f };
int ldb = 2;
float C[] = { 0.115f, -0.193f };
int ldc = 1;
float C_expected[] = { -0.056236f, 0.0f };
cblas_cher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cher2k(case 1646) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cher2k(case 1646) imag");
};
};
};
{
int order = 101;
int uplo = 122;
int trans = 111;
int N = 1;
int K = 2;
float alpha[2] = {-1.0f, 0.0f};
float beta = -0.3f;
float A[] = { -0.808f, 0.447f, 0.145f, -0.226f };
int lda = 2;
float B[] = { -0.413f, 0.904f, -0.585f, 0.717f };
int ldb = 2;
float C[] = { -0.725f, -0.244f };
int ldc = 1;
float C_expected[] = { -0.76435f, 0.0f };
cblas_cher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cher2k(case 1647) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cher2k(case 1647) imag");
};
};
};
{
int order = 102;
int uplo = 121;
int trans = 111;
int N = 1;
int K = 2;
float alpha[2] = {-1.0f, 0.0f};
float beta = -0.3f;
float A[] = { 0.337f, -0.737f, -0.993f, 0.69f };
int lda = 1;
float B[] = { -0.39f, -0.836f, -0.32f, 0.368f };
int ldb = 1;
float C[] = { 0.844f, -0.763f };
int ldc = 1;
float C_expected[] = { -2.36596f, 0.0f };
cblas_cher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cher2k(case 1648) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cher2k(case 1648) imag");
};
};
};
{
int order = 102;
int uplo = 122;
int trans = 111;
int N = 1;
int K = 2;
float alpha[2] = {-1.0f, 0.0f};
float beta = -0.3f;
float A[] = { 0.386f, -0.465f, 0.719f, -0.378f };
int lda = 1;
float B[] = { 0.099f, -0.879f, 0.864f, 0.141f };
int ldb = 1;
float C[] = { -0.599f, -0.47f };
int ldc = 1;
float C_expected[] = { -1.85003f, 0.0f };
cblas_cher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cher2k(case 1649) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cher2k(case 1649) imag");
};
};
};
{
int order = 101;
int uplo = 121;
int trans = 113;
int N = 1;
int K = 2;
float alpha[2] = {0.0f, 1.0f};
float beta = -1.0f;
float A[] = { 0.128f, 0.431f, -0.26f, 0.75f };
int lda = 1;
float B[] = { 0.276f, 0.058f, 0.904f, -0.116f };
int ldb = 1;
float C[] = { 0.914f, -0.262f };
int ldc = 1;
float C_expected[] = { 0.604744f, 0.0f };
cblas_cher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cher2k(case 1650) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cher2k(case 1650) imag");
};
};
};
{
int order = 101;
int uplo = 122;
int trans = 113;
int N = 1;
int K = 2;
float alpha[2] = {0.0f, 1.0f};
float beta = -1.0f;
float A[] = { 0.72f, 0.783f, -0.737f, 0.375f };
int lda = 1;
float B[] = { 0.531f, 0.167f, 0.203f, -0.221f };
int ldb = 1;
float C[] = { 0.618f, 0.392f };
int ldc = 1;
float C_expected[] = { -0.200438f, 0.0f };
cblas_cher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cher2k(case 1651) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cher2k(case 1651) imag");
};
};
};
{
int order = 102;
int uplo = 121;
int trans = 113;
int N = 1;
int K = 2;
float alpha[2] = {0.0f, 1.0f};
float beta = -1.0f;
float A[] = { -0.372f, -0.735f, -0.711f, 0.051f };
int lda = 2;
float B[] = { 0.257f, 0.097f, 0.338f, -0.484f };
int ldb = 2;
float C[] = { -0.142f, -0.197f };
int ldc = 1;
float C_expected[] = { -0.817394f, 0.0f };
cblas_cher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cher2k(case 1652) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cher2k(case 1652) imag");
};
};
};
{
int order = 102;
int uplo = 122;
int trans = 113;
int N = 1;
int K = 2;
float alpha[2] = {0.0f, 1.0f};
float beta = -1.0f;
float A[] = { 0.1f, -0.878f, 0.28f, -0.381f };
int lda = 2;
float B[] = { -0.208f, 0.309f, -0.276f, 0.123f };
int ldb = 2;
float C[] = { 0.483f, -0.541f };
int ldc = 1;
float C_expected[] = { -0.03812f, 0.0f };
cblas_cher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cher2k(case 1653) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cher2k(case 1653) imag");
};
};
};
{
int order = 101;
int uplo = 121;
int trans = 111;
int N = 1;
int K = 2;
double alpha[2] = {1, 0};
double beta = 1;
double A[] = { 0.515, -0.034, 0.067, 0.66 };
int lda = 2;
double B[] = { 0.408, -0.85, -0.945, -0.799 };
int ldb = 2;
double C[] = { -0.918, -0.985 };
int ldc = 1;
double C_expected[] = { -1.62127, 0.0 };
cblas_zher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zher2k(case 1654) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zher2k(case 1654) imag");
};
};
};
{
int order = 101;
int uplo = 122;
int trans = 111;
int N = 1;
int K = 2;
double alpha[2] = {1, 0};
double beta = 1;
double A[] = { -0.009, 0.495, -0.008, -0.973 };
int lda = 2;
double B[] = { -0.239, -0.373, -0.032, -0.539 };
int ldb = 2;
double C[] = { 0.443, -0.245 };
int ldc = 1;
double C_expected[] = { 1.127438, 0.0 };
cblas_zher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zher2k(case 1655) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zher2k(case 1655) imag");
};
};
};
{
int order = 102;
int uplo = 121;
int trans = 111;
int N = 1;
int K = 2;
double alpha[2] = {1, 0};
double beta = 1;
double A[] = { 0.531, 0.721, -0.848, 0.826 };
int lda = 1;
double B[] = { -0.711, -0.2, -0.92, -0.676 };
int ldb = 1;
double C[] = { -0.447, 0.701 };
int ldc = 1;
double C_expected[] = { -1.046914, 0.0 };
cblas_zher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zher2k(case 1656) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zher2k(case 1656) imag");
};
};
};
{
int order = 102;
int uplo = 122;
int trans = 111;
int N = 1;
int K = 2;
double alpha[2] = {1, 0};
double beta = 1;
double A[] = { 0.68, 0.079, 0.837, -0.814 };
int lda = 1;
double B[] = { -0.986, 0.024, 0.584, -0.248 };
int ldb = 1;
double C[] = { 0.477, -0.551 };
int ldc = 1;
double C_expected[] = { 0.521192, 0.0 };
cblas_zher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zher2k(case 1657) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zher2k(case 1657) imag");
};
};
};
{
int order = 101;
int uplo = 121;
int trans = 113;
int N = 1;
int K = 2;
double alpha[2] = {-1, 0};
double beta = 0.1;
double A[] = { -0.63, 0.787, 0.426, -0.568 };
int lda = 1;
double B[] = { -0.228, 0.302, 0.83, 0.023 };
int ldb = 1;
double C[] = { 0.354, -0.85 };
int ldc = 1;
double C_expected[] = { -1.40826, 0.0 };
cblas_zher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zher2k(case 1658) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zher2k(case 1658) imag");
};
};
};
{
int order = 101;
int uplo = 122;
int trans = 113;
int N = 1;
int K = 2;
double alpha[2] = {-1, 0};
double beta = 0.1;
double A[] = { 0.224, -0.191, 0.46, 0.464 };
int lda = 1;
double B[] = { -0.815, 0.634, 0.066, -0.873 };
int ldb = 1;
double C[] = { -0.49, -0.606 };
int ldc = 1;
double C_expected[] = { 1.307732, 0.0 };
cblas_zher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zher2k(case 1659) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zher2k(case 1659) imag");
};
};
};
{
int order = 102;
int uplo = 121;
int trans = 113;
int N = 1;
int K = 2;
double alpha[2] = {-1, 0};
double beta = 0.1;
double A[] = { 0.943, 0.075, 0.15, -0.141 };
int lda = 2;
double B[] = { -0.962, 0.422, -0.592, -0.789 };
int ldb = 2;
double C[] = { 0.728, 0.601 };
int ldc = 1;
double C_expected[] = { 1.778934, 0.0 };
cblas_zher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zher2k(case 1660) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zher2k(case 1660) imag");
};
};
};
{
int order = 102;
int uplo = 122;
int trans = 113;
int N = 1;
int K = 2;
double alpha[2] = {-1, 0};
double beta = 0.1;
double A[] = { -0.93, -0.386, 0.565, 0.141 };
int lda = 2;
double B[] = { -0.801, 0.022, 0.558, -0.932 };
int ldb = 2;
double C[] = { 0.068, 0.501 };
int ldc = 1;
double C_expected[] = { -1.833792, 0.0 };
cblas_zher2k(order, uplo, trans, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zher2k(case 1661) real");
gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zher2k(case 1661) imag");
};
};
};
}
void F77_zher2k(int *order, char *uplow, char *transp, int *n, int *k,
CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda,
CBLAS_TEST_ZOMPLEX *b, int *ldb, double *beta,
CBLAS_TEST_ZOMPLEX *c, int *ldc ) {
int i,j,LDA,LDB,LDC;
CBLAS_TEST_ZOMPLEX *A, *B, *C;
enum CBLAS_UPLO uplo;
enum CBLAS_TRANSPOSE trans;
get_uplo_type(uplow,&uplo);
get_transpose_type(transp,&trans);
if (*order == TEST_ROW_MJR) {
if (trans == CblasNoTrans) {
LDA = *k+1;
LDB = *k+1;
A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ));
B=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDB*sizeof(CBLAS_TEST_ZOMPLEX ));
for( i=0; i<*n; i++ )
for( j=0; j<*k; j++ ) {
A[i*LDA+j].real=a[j*(*lda)+i].real;
A[i*LDA+j].imag=a[j*(*lda)+i].imag;
B[i*LDB+j].real=b[j*(*ldb)+i].real;
B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
}
}
else {
LDA = *n+1;
LDB = *n+1;
A=(CBLAS_TEST_ZOMPLEX* )malloc( LDA*(*k)*sizeof(CBLAS_TEST_ZOMPLEX ) );
B=(CBLAS_TEST_ZOMPLEX* )malloc( LDB*(*k)*sizeof(CBLAS_TEST_ZOMPLEX ) );
for( i=0; i<*k; i++ )
for( j=0; j<*n; j++ ){
A[i*LDA+j].real=a[j*(*lda)+i].real;
A[i*LDA+j].imag=a[j*(*lda)+i].imag;
B[i*LDB+j].real=b[j*(*ldb)+i].real;
B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
}
}
LDC = *n+1;
C=(CBLAS_TEST_ZOMPLEX* )malloc( (*n)*LDC*sizeof(CBLAS_TEST_ZOMPLEX ) );
for( i=0; i<*n; i++ )
for( j=0; j<*n; j++ ) {
C[i*LDC+j].real=c[j*(*ldc)+i].real;
C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
}
cblas_zher2k(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA,
B, LDB, *beta, C, LDC );
for( j=0; j<*n; j++ )
for( i=0; i<*n; i++ ) {
c[j*(*ldc)+i].real=C[i*LDC+j].real;
c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
}
free(A);
free(B);
free(C);
}
else if (*order == TEST_COL_MJR)
cblas_zher2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda,
b, *ldb, *beta, c, *ldc );
else
cblas_zher2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda,
b, *ldb, *beta, c, *ldc );
}
