void F77_ztrmv(int *layout, char *uplow, char *transp, char *diagn,
int *n, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
int *incx) {
CBLAS_TEST_ZOMPLEX *A;
int i,j,LDA;
CBLAS_TRANSPOSE trans;
CBLAS_UPLO uplo;
CBLAS_DIAG diag;
get_transpose_type(transp,&trans);
get_uplo_type(uplow,&uplo);
get_diag_type(diagn,&diag);
if (*layout == TEST_ROW_MJR) {
LDA=*n+1;
A=(CBLAS_TEST_ZOMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
for( i=0; i<*n; i++ )
for( j=0; j<*n; j++ ) {
A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
}
cblas_ztrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx);
free(A);
}
else if (*layout == TEST_COL_MJR)
cblas_ztrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx);
else
cblas_ztrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx);
}
inline void trmv( const Order, const UpLo, const Trans, const Diag,
const int n, const std::complex<double>* a, const int lda,
std::complex<double>* x, const int incx ) {
cblas_ztrmv( cblas_option< Order >::value, cblas_option< UpLo >::value,
cblas_option< Trans >::value, cblas_option< Diag >::value, n, a,
lda, x, incx );
}
inline void trmv(
CBLAS_ORDER const Order,
CBLAS_UPLO const uplo,
CBLAS_TRANSPOSE const transA,
CBLAS_DIAG const unit,
int const N,
std::complex<double> const *A, int const lda,
std::complex<double>* X, int const incX
) {
cblas_ztrmv(Order, uplo, transA, unit, N,
static_cast<void const *>(A), lda,
static_cast<void *>(X), incX
);
}
inline void trmv(
CBLAS_ORDER const Order,
CBLAS_UPLO const uplo,
CBLAS_TRANSPOSE const transA,
CBLAS_DIAG const unit,
int const N,
std::complex<double> const *A, int const lda,
std::complex<double>* X, int const incX
) {
cblas_ztrmv(Order, uplo, transA, unit, N,
reinterpret_cast<cblas_double_complex_type const *>(A), lda,
reinterpret_cast<cblas_double_complex_type *>(X), incX
);
}
void bl1_ztrmv_blas( uplo1_t uplo, trans1_t trans, diag1_t diag, int m, dcomplex* a, int lda, dcomplex* x, int incx )
{
#ifdef BLIS1_ENABLE_CBLAS_INTERFACES
enum CBLAS_ORDER cblas_order = CblasColMajor;
enum CBLAS_UPLO cblas_uplo;
enum CBLAS_TRANSPOSE cblas_trans;
enum CBLAS_DIAG cblas_diag;
bl1_param_map_to_netlib_uplo( uplo, &cblas_uplo );
bl1_param_map_to_netlib_trans( trans, &cblas_trans );
bl1_param_map_to_netlib_diag( diag, &cblas_diag );
cblas_ztrmv( cblas_order,
cblas_uplo,
cblas_trans,
cblas_diag,
m,
a, lda,
x, incx );
#else
char blas_uplo;
char blas_trans;
char blas_diag;
bl1_param_map_to_netlib_uplo( uplo, &blas_uplo );
bl1_param_map_to_netlib_trans( trans, &blas_trans );
bl1_param_map_to_netlib_diag( diag, &blas_diag );
F77_ztrmv( &blas_uplo,
&blas_trans,
&blas_diag,
&m,
a, &lda,
x, &incx );
#endif
}
int CORE_zttlqt(int M, int N, int IB,
PLASMA_Complex64_t *A1, int LDA1,
PLASMA_Complex64_t *A2, int LDA2,
PLASMA_Complex64_t *T, int LDT,
PLASMA_Complex64_t *TAU, PLASMA_Complex64_t *WORK)
{
static PLASMA_Complex64_t zone = 1.0;
static PLASMA_Complex64_t zzero = 0.0;
#ifdef COMPLEX
static int ione = 1;
#endif
PLASMA_Complex64_t alpha;
int i, j, l, ii, sb, mi, ni;
/* Check input arguments */
if (M < 0) {
coreblas_error(1, "Illegal value of M");
return -1;
}
if (N < 0) {
coreblas_error(2, "Illegal value of N");
return -2;
}
if (IB < 0) {
coreblas_error(3, "Illegal value of IB");
return -3;
}
if ((LDA2 < max(1,M)) && (M > 0)) {
coreblas_error(7, "Illegal value of LDA2");
return -7;
}
/* Quick return */
if ((M == 0) || (N == 0) || (IB == 0))
return PLASMA_SUCCESS;
/* TODO: Need to check why some cases require
* this to not have uninitialized values */
CORE_zlaset( PlasmaUpperLower, IB, N,
0., 0., T, LDT);
for(ii = 0; ii < M; ii += IB) {
sb = min(M-ii, IB);
for(i = 0; i < sb; i++) {
j = ii + i;
mi = sb-i-1;
ni = min( j + 1, N);
/*
* Generate elementary reflector H( II*IB+I ) to annihilate A( II*IB+I, II*IB+I:M ).
*/
#ifdef COMPLEX
LAPACKE_zlacgv_work(ni, &A2[j], LDA2);
LAPACKE_zlacgv_work(ione, &A1[LDA1*j+j], LDA1);
#endif
LAPACKE_zlarfg_work(ni+1, &A1[LDA1*j+j], &A2[j], LDA2, &TAU[j]);
if (mi > 0) {
/*
* Apply H( j-1 ) to A( j:II+IB-1, j-1:M ) from the right.
*/
cblas_zcopy(
mi,
&A1[LDA1*j+(j+1)], 1,
WORK, 1);
cblas_zgemv(
CblasColMajor, (CBLAS_TRANSPOSE)PlasmaNoTrans,
mi, ni,
CBLAS_SADDR(zone), &A2[j+1], LDA2,
&A2[j], LDA2,
CBLAS_SADDR(zone), WORK, 1);
alpha = -(TAU[j]);
cblas_zaxpy(
mi, CBLAS_SADDR(alpha),
WORK, 1,
&A1[LDA1*j+j+1], 1);
cblas_zgerc(
CblasColMajor, mi, ni,
CBLAS_SADDR(alpha), WORK, 1,
&A2[j], LDA2,
&A2[j+1], LDA2);
}
/*
* Calculate T.
*/
if (i > 0 ) {
l = min(i, max(0, N-ii));
alpha = -(TAU[j]);
CORE_zpemv(
PlasmaNoTrans, PlasmaRowwise,
i , min(j, N), l,
alpha, &A2[ii], LDA2,
&A2[j], LDA2,
zzero, &T[LDT*j], 1,
WORK);
/* T(0:i-1, j) = T(0:i-1, ii:j-1) * T(0:i-1, j) */
cblas_ztrmv(
CblasColMajor, (CBLAS_UPLO)PlasmaUpper,
(CBLAS_TRANSPOSE)PlasmaNoTrans,
(CBLAS_DIAG)PlasmaNonUnit,
i, &T[LDT*ii], LDT,
&T[LDT*j], 1);
}
#ifdef COMPLEX
LAPACKE_zlacgv_work(ni, &A2[j], LDA2 );
LAPACKE_zlacgv_work(ione, &A1[LDA1*j+j], LDA1 );
#endif
T[LDT*j+i] = TAU[j];
}
/* Apply Q to the rest of the matrix to the right */
if (M > ii+sb) {
mi = M-(ii+sb);
ni = min(ii+sb, N);
l = min(sb, max(0, ni-ii));
CORE_zparfb(
PlasmaRight, PlasmaNoTrans,
PlasmaForward, PlasmaRowwise,
mi, IB, mi, ni, sb, l,
&A1[LDA1*ii+ii+sb], LDA1,
&A2[ii+sb], LDA2,
&A2[ii], LDA2,
&T[LDT*ii], LDT,
WORK, M);
}
}
return PLASMA_SUCCESS;
}
int CORE_zttqrt(int M, int N, int IB,
PLASMA_Complex64_t *A1, int LDA1,
PLASMA_Complex64_t *A2, int LDA2,
PLASMA_Complex64_t *T, int LDT,
PLASMA_Complex64_t *TAU, PLASMA_Complex64_t *WORK)
{
static PLASMA_Complex64_t zone = 1.0;
static PLASMA_Complex64_t zzero = 0.0;
static int ione = 1;
PLASMA_Complex64_t alpha;
int i, j, ii, sb, mi, ni;
/* Check input arguments */
if (M < 0) {
coreblas_error(1, "Illegal value of M");
return -1;
}
if (N < 0) {
coreblas_error(2, "Illegal value of N");
return -2;
}
if (IB < 0) {
coreblas_error(3, "Illegal value of IB");
return -3;
}
if ((LDA2 < max(1,M)) && (M > 0)) {
coreblas_error(7, "Illegal value of LDA2");
return -7;
}
/* Quick return */
if ((M == 0) || (N == 0) || (IB == 0))
return PLASMA_SUCCESS;
for(ii = 0; ii < N; ii += IB) {
sb = min(N-ii, IB);
for(i = 0; i < sb; i++) {
/*
* Generate elementary reflector H( II*IB+I ) to annihilate
* A( II*IB+I:mi, II*IB+I ).
*/
mi = ii + i + 1;
LAPACKE_zlarfg_work(mi+1, &A1[LDA1*(ii+i)+ii+i], &A2[LDA2*(ii+i)], ione, &TAU[ii+i]);
if (sb-i-1>0) {
/*
* Apply H( II*IB+I ) to A( II*IB+I:M, II*IB+I+1:II*IB+IB ) from the left.
*/
ni = sb-i-1;
cblas_zcopy(
ni,
&A1[LDA1*(ii+i+1)+(ii+i)], LDA1,
WORK, 1);
#ifdef COMPLEX
LAPACKE_zlacgv_work(ni, WORK, ione);
#endif
cblas_zgemv(
CblasColMajor, (CBLAS_TRANSPOSE)PlasmaConjTrans,
mi, ni,
CBLAS_SADDR(zone), &A2[LDA2*(ii+i+1)], LDA2,
&A2[LDA2*(ii+i)], 1,
CBLAS_SADDR(zone), WORK, 1);
#ifdef COMPLEX
LAPACKE_zlacgv_work(ni, WORK, ione);
#endif
alpha = -conj(TAU[ii+i]);
cblas_zaxpy(
ni, CBLAS_SADDR(alpha),
WORK, 1,
&A1[LDA1*(ii+i+1)+ii+i], LDA1);
#ifdef COMPLEX
LAPACKE_zlacgv_work(ni, WORK, ione);
#endif
cblas_zgerc(
CblasColMajor, mi, ni,
CBLAS_SADDR(alpha), &A2[LDA2*(ii+i)], 1,
WORK, 1,
&A2[LDA2*(ii+i+1)], LDA2);
}
/*
* Calculate T.
*/
if (i > 0 ) {
cblas_zcopy(i, &A2[LDA2*(ii+i)+ii], 1, &WORK[ii], 1);
cblas_ztrmv(
CblasColMajor, (CBLAS_UPLO)PlasmaUpper,
(CBLAS_TRANSPOSE)PlasmaConjTrans, (CBLAS_DIAG)PlasmaNonUnit,
i, &A2[LDA2*ii+ii], LDA2,
&WORK[ii], 1);
alpha = -(TAU[ii+i]);
for(j = 0; j < i; j++) {
WORK[ii+j] = alpha * WORK[ii+j];
}
if (ii > 0) {
cblas_zgemv(
CblasColMajor, (CBLAS_TRANSPOSE)PlasmaConjTrans, ii, i,
CBLAS_SADDR(alpha), &A2[LDA2*ii], LDA2,
&A2[LDA2*(ii+i)], 1,
CBLAS_SADDR(zzero), WORK, 1);
cblas_zaxpy(i, CBLAS_SADDR(zone), &WORK[ii], 1, WORK, 1);
}
cblas_zcopy(i, WORK, 1, &T[LDT*(ii+i)], 1);
cblas_ztrmv(
CblasColMajor, (CBLAS_UPLO)PlasmaUpper,
(CBLAS_TRANSPOSE)PlasmaNoTrans, (CBLAS_DIAG)PlasmaNonUnit,
i, &T[LDT*ii], LDT,
&T[LDT*(ii+i)], 1);
}
T[LDT*(ii+i)+i] = TAU[ii+i];
}
/* Apply Q' to the rest of the matrix to the left */
if (N > ii+sb) {
CORE_zttrfb(
PlasmaLeft, PlasmaConjTrans,
PlasmaForward, PlasmaColumnwise,
sb, N-(ii+sb), ii+sb, N-(ii+sb), sb,
&A1[LDA1*(ii+sb)+ii], LDA1,
&A2[LDA2*(ii+sb)], LDA2,
&A2[LDA2*ii], LDA2,
&T[LDT*ii], LDT,
WORK, sb);
}
}
return PLASMA_SUCCESS;
}
int CORE_ztsqrt(int M, int N, int IB,
PLASMA_Complex64_t *A1, int LDA1,
PLASMA_Complex64_t *A2, int LDA2,
PLASMA_Complex64_t *T, int LDT,
PLASMA_Complex64_t *TAU, PLASMA_Complex64_t *WORK)
{
static PLASMA_Complex64_t zone = 1.0;
static PLASMA_Complex64_t zzero = 0.0;
PLASMA_Complex64_t alpha;
int i, ii, sb;
/* Check input arguments */
if (M < 0) {
coreblas_error(1, "Illegal value of M");
return -1;
}
if (N < 0) {
coreblas_error(2, "Illegal value of N");
return -2;
}
if (IB < 0) {
coreblas_error(3, "Illegal value of IB");
return -3;
}
if ((LDA2 < max(1,M)) && (M > 0)) {
coreblas_error(8, "Illegal value of LDA2");
return -8;
}
/* Quick return */
if ((M == 0) || (N == 0) || (IB == 0))
return PLASMA_SUCCESS;
for(ii = 0; ii < N; ii += IB) {
sb = min(N-ii, IB);
for(i = 0; i < sb; i++) {
/*
* Generate elementary reflector H( II*IB+I ) to annihilate
* A( II*IB+I:M, II*IB+I )
*/
LAPACKE_zlarfg_work(M+1, &A1[LDA1*(ii+i)+ii+i], &A2[LDA2*(ii+i)], 1, &TAU[ii+i]);
if (ii+i+1 < N) {
/*
* Apply H( II*IB+I ) to A( II*IB+I:M, II*IB+I+1:II*IB+IB ) from the left
*/
alpha = -conj(TAU[ii+i]);
cblas_zcopy(
sb-i-1,
&A1[LDA1*(ii+i+1)+(ii+i)], LDA1,
WORK, 1);
#ifdef COMPLEX
LAPACKE_zlacgv_work(sb-i-1, WORK, 1);
#endif
cblas_zgemv(
CblasColMajor, (CBLAS_TRANSPOSE)PlasmaConjTrans,
M, sb-i-1,
CBLAS_SADDR(zone), &A2[LDA2*(ii+i+1)], LDA2,
&A2[LDA2*(ii+i)], 1,
CBLAS_SADDR(zone), WORK, 1);
#ifdef COMPLEX
LAPACKE_zlacgv_work(sb-i-1, WORK, 1 );
#endif
cblas_zaxpy(
sb-i-1, CBLAS_SADDR(alpha),
WORK, 1,
&A1[LDA1*(ii+i+1)+ii+i], LDA1);
#ifdef COMPLEX
LAPACKE_zlacgv_work(sb-i-1, WORK, 1 );
#endif
cblas_zgerc(
CblasColMajor, M, sb-i-1, CBLAS_SADDR(alpha),
&A2[LDA2*(ii+i)], 1,
WORK, 1,
&A2[LDA2*(ii+i+1)], LDA2);
}
/*
* Calculate T
*/
alpha = -TAU[ii+i];
cblas_zgemv(
CblasColMajor, (CBLAS_TRANSPOSE)PlasmaConjTrans, M, i,
CBLAS_SADDR(alpha), &A2[LDA2*ii], LDA2,
&A2[LDA2*(ii+i)], 1,
CBLAS_SADDR(zzero), &T[LDT*(ii+i)], 1);
cblas_ztrmv(
CblasColMajor, (CBLAS_UPLO)PlasmaUpper,
(CBLAS_TRANSPOSE)PlasmaNoTrans, (CBLAS_DIAG)PlasmaNonUnit, i,
&T[LDT*ii], LDT,
&T[LDT*(ii+i)], 1);
T[LDT*(ii+i)+i] = TAU[ii+i];
}
if (N > ii+sb) {
CORE_ztsmqr(
PlasmaLeft, PlasmaConjTrans,
sb, N-(ii+sb), M, N-(ii+sb), IB, IB,
&A1[LDA1*(ii+sb)+ii], LDA1,
&A2[LDA2*(ii+sb)], LDA2,
&A2[LDA2*ii], LDA2,
&T[LDT*ii], LDT,
WORK, sb);
}
}
return PLASMA_SUCCESS;
}
