void eblas_zscal(int N, const complex& a, complex* x, int incx)
{
#ifdef MKL_PROVIDES_BLAS
cblas_zscal(N, &a, x, incx);
#else
threadLaunch((N<100000) ? 1 : 0,
eblas_zscal_sub, N, &a, x, incx);
#endif
}
VrArrayPtrCF64 BlasComplexDouble::scal_mult(int ndims,VrArrayPtrCF64 X,double complex alpha){
int N=1;
for(int i=0;i<ndims;i++){
N*=VR_GET_DIMS_CF64(X)[i];
}
//mexPrintf("%d",N);
double alph[] = {1,0};
VrArrayPtrCF64 Y=vec_copy(ndims,X);
cblas_zscal(N,(alph),(double*)VR_GET_DATA_CF64(Y),1);
return Y;
}
void phi_scal(const int N, const Complex *alpha, Complex *X, const int incX){
#ifndef NOBLAS
#ifdef SINGLEPRECISION
cblas_cscal(N,alpha,X,incX);
#else
cblas_zscal(N,alpha,X,incX);
#endif
#else
int i;
for(i = 0; i < N; ++i, X+=incX){
*X *= (*alpha);
}
#endif
}
void eblas_zscal_sub(size_t iStart, size_t iStop, const complex* a, complex* x, int incx)
{ cblas_zscal(iStop-iStart, a, x+incx*iStart, incx);
}
extern "C" magma_int_t
magma_zgeev(magma_vec_t jobvl, magma_vec_t jobvr, magma_int_t n,
magmaDoubleComplex *a, magma_int_t lda,
magmaDoubleComplex *geev_w_array,
magmaDoubleComplex *vl, magma_int_t ldvl,
magmaDoubleComplex *vr, magma_int_t ldvr,
magmaDoubleComplex *work, magma_int_t lwork,
double *rwork, magma_int_t *info, magma_queue_t queue)
{
/* -- clMAGMA (version 1.0.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
September 2012
Purpose
=======
ZGEEV computes for an N-by-N complex nonsymmetric matrix A, the
eigenvalues and, optionally, the left and/or right eigenvectors.
The right eigenvector v(j) of A satisfies
A * v(j) = lambda(j) * v(j)
where lambda(j) is its eigenvalue.
The left eigenvector u(j) of A satisfies
u(j)**H * A = lambda(j) * u(j)**H
where u(j)**H denotes the conjugate transpose of u(j).
The computed eigenvectors are normalized to have Euclidean norm
equal to 1 and largest component real.
Arguments
=========
JOBVL (input) CHARACTER*1
= 'N': left eigenvectors of A are not computed;
= 'V': left eigenvectors of are computed.
JOBVR (input) CHARACTER*1
= 'N': right eigenvectors of A are not computed;
= 'V': right eigenvectors of A are computed.
N (input) INTEGER
The order of the matrix A. N >= 0.
A (input/output) COMPLEX*16 array, dimension (LDA,N)
On entry, the N-by-N matrix A.
On exit, A has been overwritten.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
W (output) COMPLEX*16 array, dimension (N)
W contains the computed eigenvalues.
VL (output) COMPLEX*16 array, dimension (LDVL,N)
If JOBVL = 'V', the left eigenvectors u(j) are stored one
after another in the columns of VL, in the same order
as their eigenvalues.
If JOBVL = 'N', VL is not referenced.
u(j) = VL(:,j), the j-th column of VL.
LDVL (input) INTEGER
The leading dimension of the array VL. LDVL >= 1; if
JOBVL = 'V', LDVL >= N.
VR (output) COMPLEX*16 array, dimension (LDVR,N)
If JOBVR = 'V', the right eigenvectors v(j) are stored one
after another in the columns of VR, in the same order
as their eigenvalues.
If JOBVR = 'N', VR is not referenced.
v(j) = VR(:,j), the j-th column of VR.
LDVR (input) INTEGER
The leading dimension of the array VR. LDVR >= 1; if
JOBVR = 'V', LDVR >= N.
WORK (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= (1+nb)*N.
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued by XERBLA.
RWORK (workspace) DOUBLE PRECISION array, dimension (2*N)
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value.
> 0: if INFO = i, the QR algorithm failed to compute all the
eigenvalues, and no eigenvectors have been computed;
elements and i+1:N of W contain eigenvalues which have
converged.
===================================================================== */
magma_int_t c__1 = 1;
magma_int_t c__0 = 0;
magma_int_t a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1,
i__2, i__3;
double d__1, d__2;
magmaDoubleComplex z__1, z__2;
magma_int_t i__, k, ihi;
double scl;
magma_int_t ilo;
double dum[1], eps;
magmaDoubleComplex tmp;
magma_int_t ibal;
double anrm;
magma_int_t ierr, itau, iwrk, nout;
magma_int_t scalea;
double cscale;
magma_int_t select[1];
double bignum;
magma_int_t minwrk;
magma_int_t wantvl;
double smlnum;
magma_int_t irwork;
magma_int_t lquery, wantvr;
magma_int_t nb = 0;
magmaDoubleComplex_ptr dT;
//magma_timestr_t start, end;
char side[2] = {0, 0};
magma_vec_t jobvl_ = jobvl;
magma_vec_t jobvr_ = jobvr;
*info = 0;
lquery = lwork == -1;
wantvl = lapackf77_lsame(lapack_const(jobvl_), "V");
wantvr = lapackf77_lsame(lapack_const(jobvr_), "V");
if (! wantvl && ! lapackf77_lsame(lapack_const(jobvl_), "N")) {
*info = -1;
} else if (! wantvr && ! lapackf77_lsame(lapack_const(jobvr_), "N")) {
*info = -2;
} else if (n < 0) {
*info = -3;
} else if (lda < max(1,n)) {
*info = -5;
} else if ( (ldvl < 1) || (wantvl && (ldvl < n))) {
*info = -8;
} else if ( (ldvr < 1) || (wantvr && (ldvr < n))) {
*info = -10;
}
/* Compute workspace */
if (*info == 0) {
nb = magma_get_zgehrd_nb(n);
minwrk = (1+nb)*n;
work[0] = MAGMA_Z_MAKE((double) minwrk, 0.);
if (lwork < minwrk && ! lquery) {
*info = -12;
}
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery) {
return *info;
}
/* Quick return if possible */
if (n == 0) {
return *info;
}
// if eigenvectors are needed
#if defined(VERSION3)
if (MAGMA_SUCCESS != magma_malloc(&dT, nb*n*sizeof(magmaDoubleComplex) )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
#endif
a_dim1 = lda;
a_offset = 1 + a_dim1;
a -= a_offset;
vl_dim1 = ldvl;
vl_offset = 1 + vl_dim1;
vl -= vl_offset;
vr_dim1 = ldvr;
vr_offset = 1 + vr_dim1;
vr -= vr_offset;
--work;
--rwork;
/* Get machine constants */
eps = lapackf77_dlamch("P");
smlnum = lapackf77_dlamch("S");
bignum = 1. / smlnum;
lapackf77_dlabad(&smlnum, &bignum);
smlnum = magma_dsqrt(smlnum) / eps;
bignum = 1. / smlnum;
/* Scale A if max element outside range [SMLNUM,BIGNUM] */
anrm = lapackf77_zlange("M", &n, &n, &a[a_offset], &lda, dum);
scalea = 0;
if (anrm > 0. && anrm < smlnum) {
scalea = 1;
cscale = smlnum;
} else if (anrm > bignum) {
scalea = 1;
cscale = bignum;
}
if (scalea) {
lapackf77_zlascl("G", &c__0, &c__0, &anrm, &cscale, &n, &n, &a[a_offset], &lda, &
ierr);
}
/* Balance the matrix
(CWorkspace: none)
(RWorkspace: need N) */
ibal = 1;
lapackf77_zgebal("B", &n, &a[a_offset], &lda, &ilo, &ihi, &rwork[ibal], &ierr);
/* Reduce to upper Hessenberg form
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: none) */
itau = 1;
iwrk = itau + n;
i__1 = lwork - iwrk + 1;
//start = get_current_time();
#if defined(VERSION1)
/*
* Version 1 - LAPACK
*/
lapackf77_zgehrd(&n, &ilo, &ihi, &a[a_offset], &lda,
&work[itau], &work[iwrk], &i__1, &ierr);
#elif defined(VERSION2)
/*
* Version 2 - LAPACK consistent HRD
*/
magma_zgehrd2(n, ilo, ihi, &a[a_offset], lda,
&work[itau], &work[iwrk], &i__1, &ierr);
#elif defined(VERSION3)
/*
* Version 3 - LAPACK consistent MAGMA HRD + matrices T stored,
*/
magma_zgehrd(n, ilo, ihi, &a[a_offset], lda,
&work[itau], &work[iwrk], i__1, dT, 0, &ierr, queue);
#endif
//end = get_current_time();
//printf(" Time for zgehrd = %5.2f sec\n", GetTimerValue(start,end)/1000.);
if (wantvl) {
/* Want left eigenvectors
Copy Householder vectors to VL */
side[0] = 'L';
lapackf77_zlacpy(MagmaLowerStr, &n, &n,
&a[a_offset], &lda, &vl[vl_offset], &ldvl);
/* Generate unitary matrix in VL
(CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
(RWorkspace: none) */
i__1 = lwork - iwrk + 1;
//start = get_current_time();
#if defined(VERSION1) || defined(VERSION2)
/*
* Version 1 & 2 - LAPACK
*/
lapackf77_zunghr(&n, &ilo, &ihi, &vl[vl_offset], &ldvl,
&work[itau], &work[iwrk], &i__1, &ierr);
#elif defined(VERSION3)
/*
* Version 3 - LAPACK consistent MAGMA HRD + matrices T stored
*/
magma_zunghr(n, ilo, ihi, &vl[vl_offset], ldvl, &work[itau],
dT, 0, nb, &ierr, queue);
#endif
//end = get_current_time();
//printf(" Time for zunghr = %5.2f sec\n", GetTimerValue(start,end)/1000.);
/* Perform QR iteration, accumulating Schur vectors in VL
(CWorkspace: need 1, prefer HSWORK (see comments) )
(RWorkspace: none) */
iwrk = itau;
i__1 = lwork - iwrk + 1;
lapackf77_zhseqr("S", "V", &n, &ilo, &ihi, &a[a_offset], &lda, geev_w_array,
&vl[vl_offset], &ldvl, &work[iwrk], &i__1, info);
if (wantvr)
{
/* Want left and right eigenvectors
Copy Schur vectors to VR */
side[0] = 'B';
lapackf77_zlacpy("F", &n, &n, &vl[vl_offset], &ldvl, &vr[vr_offset], &ldvr);
}
} else if (wantvr) {
/* Want right eigenvectors
Copy Householder vectors to VR */
side[0] = 'R';
lapackf77_zlacpy("L", &n, &n, &a[a_offset], &lda, &vr[vr_offset], &ldvr);
/* Generate unitary matrix in VR
(CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
(RWorkspace: none) */
i__1 = lwork - iwrk + 1;
//start = get_current_time();
#if defined(VERSION1) || defined(VERSION2)
/*
* Version 1 & 2 - LAPACK
*/
lapackf77_zunghr(&n, &ilo, &ihi, &vr[vr_offset], &ldvr,
&work[itau], &work[iwrk], &i__1, &ierr);
#elif defined(VERSION3)
/*
* Version 3 - LAPACK consistent MAGMA HRD + matrices T stored
*/
magma_zunghr(n, ilo, ihi, &vr[vr_offset], ldvr,
&work[itau], dT, 0, nb, &ierr, queue);
#endif
//end = get_current_time();
//printf(" Time for zunghr = %5.2f sec\n", GetTimerValue(start,end)/1000.);
/* Perform QR iteration, accumulating Schur vectors in VR
(CWorkspace: need 1, prefer HSWORK (see comments) )
(RWorkspace: none) */
iwrk = itau;
i__1 = lwork - iwrk + 1;
lapackf77_zhseqr("S", "V", &n, &ilo, &ihi, &a[a_offset], &lda, geev_w_array,
&vr[vr_offset], &ldvr, &work[iwrk], &i__1, info);
} else {
/* Compute eigenvalues only
(CWorkspace: need 1, prefer HSWORK (see comments) )
(RWorkspace: none) */
iwrk = itau;
i__1 = lwork - iwrk + 1;
lapackf77_zhseqr("E", "N", &n, &ilo, &ihi, &a[a_offset], &lda, geev_w_array,
&vr[vr_offset], &ldvr, &work[iwrk], &i__1, info);
}
/* If INFO > 0 from ZHSEQR, then quit */
if (*info > 0) {
goto L50;
}
if (wantvl || wantvr) {
/* Compute left and/or right eigenvectors
(CWorkspace: need 2*N)
(RWorkspace: need 2*N) */
irwork = ibal + n;
lapackf77_ztrevc(side, "B", select, &n, &a[a_offset], &lda, &vl[vl_offset], &ldvl,
&vr[vr_offset], &ldvr, &n, &nout, &work[iwrk], &rwork[irwork],
&ierr);
}
if (wantvl) {
/* Undo balancing of left eigenvectors
(CWorkspace: none)
(RWorkspace: need N) */
lapackf77_zgebak("B", "L", &n, &ilo, &ihi, &rwork[ibal], &n,
&vl[vl_offset], &ldvl, &ierr);
/* Normalize left eigenvectors and make largest component real */
for (i__ = 1; i__ <= n; ++i__) {
scl = 1. / cblas_dznrm2(n, &vl[i__ * vl_dim1 + 1], 1);
cblas_zdscal(n, scl, &vl[i__ * vl_dim1 + 1], 1);
i__2 = n;
for (k = 1; k <= i__2; ++k)
{
i__3 = k + i__ * vl_dim1;
/* Computing 2nd power */
d__1 = MAGMA_Z_REAL(vl[i__3]);
/* Computing 2nd power */
d__2 = MAGMA_Z_IMAG(vl[k + i__ * vl_dim1]);
rwork[irwork + k - 1] = d__1 * d__1 + d__2 * d__2;
}
/* Comment:
Fortran BLAS does not have to add 1
C BLAS must add one to cblas_idamax */
k = cblas_idamax(n, &rwork[irwork], 1)+1;
z__2 = MAGMA_Z_CNJG(vl[k + i__ * vl_dim1]);
d__1 = magma_dsqrt(rwork[irwork + k - 1]);
MAGMA_Z_DSCALE(z__1, z__2, d__1);
tmp = z__1;
cblas_zscal(n, CBLAS_SADDR(tmp), &vl[i__ * vl_dim1 + 1], 1);
i__2 = k + i__ * vl_dim1;
i__3 = k + i__ * vl_dim1;
d__1 = MAGMA_Z_REAL(vl[i__3]);
MAGMA_Z_SET2REAL(z__1, d__1);
vl[i__2] = z__1;
}
}
if (wantvr) {
/* Undo balancing of right eigenvectors
(CWorkspace: none)
(RWorkspace: need N) */
lapackf77_zgebak("B", "R", &n, &ilo, &ihi, &rwork[ibal], &n,
&vr[vr_offset], &ldvr, &ierr);
/* Normalize right eigenvectors and make largest component real */
for (i__ = 1; i__ <= n; ++i__) {
scl = 1. / cblas_dznrm2(n, &vr[i__ * vr_dim1 + 1], 1);
cblas_zdscal(n, scl, &vr[i__ * vr_dim1 + 1], 1);
i__2 = n;
for (k = 1; k <= i__2; ++k) {
i__3 = k + i__ * vr_dim1;
/* Computing 2nd power */
d__1 = MAGMA_Z_REAL(vr[i__3]);
/* Computing 2nd power */
d__2 = MAGMA_Z_IMAG(vr[k + i__ * vr_dim1]);
rwork[irwork + k - 1] = d__1 * d__1 + d__2 * d__2;
}
/* Comment:
Fortran BLAS does not have to add 1
C BLAS must add one to cblas_idamax */
k = cblas_idamax(n, &rwork[irwork], 1)+1;
z__2 = MAGMA_Z_CNJG(vr[k + i__ * vr_dim1]);
d__1 = magma_dsqrt(rwork[irwork + k - 1]);
MAGMA_Z_DSCALE(z__1, z__2, d__1);
tmp = z__1;
cblas_zscal(n, CBLAS_SADDR(tmp), &vr[i__ * vr_dim1 + 1], 1);
i__2 = k + i__ * vr_dim1;
i__3 = k + i__ * vr_dim1;
d__1 = MAGMA_Z_REAL(vr[i__3]);
MAGMA_Z_SET2REAL(z__1, d__1);
vr[i__2] = z__1;
}
}
/* Undo scaling if necessary */
L50:
if (scalea) {
i__1 = n - *info;
/* Computing MAX */
i__3 = n - *info;
i__2 = max(i__3,1);
lapackf77_zlascl("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1,
geev_w_array + *info, &i__2, &ierr);
if (*info > 0) {
i__1 = ilo - 1;
lapackf77_zlascl("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1,
geev_w_array, &n, &ierr);
}
}
#if defined(VERSION3)
magma_free( dT );
#endif
return *info;
} /* magma_zgeev */
extern "C" magma_int_t
magma_zgeev_m(
char jobvl, char jobvr, magma_int_t n,
magmaDoubleComplex *A, magma_int_t lda,
magmaDoubleComplex *W,
magmaDoubleComplex *vl, magma_int_t ldvl,
magmaDoubleComplex *vr, magma_int_t ldvr,
magmaDoubleComplex *work, magma_int_t lwork,
double *rwork, magma_int_t *info )
{
/* -- MAGMA (version 1.4.1) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
December 2013
Purpose
=======
ZGEEV computes for an N-by-N complex nonsymmetric matrix A, the
eigenvalues and, optionally, the left and/or right eigenvectors.
The right eigenvector v(j) of A satisfies
A * v(j) = lambda(j) * v(j)
where lambda(j) is its eigenvalue.
The left eigenvector u(j) of A satisfies
u(j)**H * A = lambda(j) * u(j)**H
where u(j)**H denotes the conjugate transpose of u(j).
The computed eigenvectors are normalized to have Euclidean norm
equal to 1 and largest component real.
Arguments
=========
JOBVL (input) CHARACTER*1
= 'N': left eigenvectors of A are not computed;
= 'V': left eigenvectors of are computed.
JOBVR (input) CHARACTER*1
= 'N': right eigenvectors of A are not computed;
= 'V': right eigenvectors of A are computed.
N (input) INTEGER
The order of the matrix A. N >= 0.
A (input/output) COMPLEX*16 array, dimension (LDA,N)
On entry, the N-by-N matrix A.
On exit, A has been overwritten.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
W (output) COMPLEX*16 array, dimension (N)
W contains the computed eigenvalues.
VL (output) COMPLEX*16 array, dimension (LDVL,N)
If JOBVL = 'V', the left eigenvectors u(j) are stored one
after another in the columns of VL, in the same order
as their eigenvalues.
If JOBVL = 'N', VL is not referenced.
u(j) = VL(:,j), the j-th column of VL.
LDVL (input) INTEGER
The leading dimension of the array VL. LDVL >= 1; if
JOBVL = 'V', LDVL >= N.
VR (output) COMPLEX*16 array, dimension (LDVR,N)
If JOBVR = 'V', the right eigenvectors v(j) are stored one
after another in the columns of VR, in the same order
as their eigenvalues.
If JOBVR = 'N', VR is not referenced.
v(j) = VR(:,j), the j-th column of VR.
LDVR (input) INTEGER
The leading dimension of the array VR. LDVR >= 1; if
JOBVR = 'V', LDVR >= N.
WORK (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= (1+nb)*N.
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued by XERBLA.
RWORK (workspace) DOUBLE PRECISION array, dimension (2*N)
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value.
> 0: if INFO = i, the QR algorithm failed to compute all the
eigenvalues, and no eigenvectors have been computed;
elements and i+1:N of W contain eigenvalues which have
converged.
===================================================================== */
#define vl(i,j) (vl + (i) + (j)*ldvl)
#define vr(i,j) (vr + (i) + (j)*ldvr)
magma_int_t c_one = 1;
magma_int_t c_zero = 0;
double d__1, d__2;
magmaDoubleComplex z__1, z__2;
magmaDoubleComplex tmp;
double scl;
double dum[1], eps;
double anrm, cscale, bignum, smlnum;
magma_int_t i, k, ilo, ihi;
magma_int_t ibal, ierr, itau, iwrk, nout, liwrk, i__1, i__2, nb;
magma_int_t scalea, minwrk, irwork, lquery, wantvl, wantvr, select[1];
char side[2] = {0, 0};
char jobvl_[2] = {jobvl, 0};
char jobvr_[2] = {jobvr, 0};
irwork = 0;
*info = 0;
lquery = lwork == -1;
wantvl = lapackf77_lsame( jobvl_, "V" );
wantvr = lapackf77_lsame( jobvr_, "V" );
if (! wantvl && ! lapackf77_lsame( jobvl_, "N" )) {
*info = -1;
} else if (! wantvr && ! lapackf77_lsame( jobvr_, "N" )) {
*info = -2;
} else if (n < 0) {
*info = -3;
} else if (lda < max(1,n)) {
*info = -5;
} else if ( (ldvl < 1) || (wantvl && (ldvl < n))) {
*info = -8;
} else if ( (ldvr < 1) || (wantvr && (ldvr < n))) {
*info = -10;
}
/* Compute workspace */
nb = magma_get_zgehrd_nb( n );
if (*info == 0) {
minwrk = (1+nb)*n;
work[0] = MAGMA_Z_MAKE( minwrk, 0 );
if (lwork < minwrk && ! lquery) {
*info = -12;
}
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery) {
return *info;
}
/* Quick return if possible */
if (n == 0) {
return *info;
}
#if defined(Version3) || defined(Version4) || defined(Version5)
magmaDoubleComplex *dT;
if (MAGMA_SUCCESS != magma_zmalloc( &dT, nb*n )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
#endif
#if defined(Version4) || defined(Version5)
magmaDoubleComplex *T;
if (MAGMA_SUCCESS != magma_zmalloc_cpu( &T, nb*n )) {
magma_free( dT );
*info = MAGMA_ERR_HOST_ALLOC;
return *info;
}
#endif
/* Get machine constants */
eps = lapackf77_dlamch( "P" );
smlnum = lapackf77_dlamch( "S" );
bignum = 1. / smlnum;
lapackf77_dlabad( &smlnum, &bignum );
smlnum = magma_dsqrt( smlnum ) / eps;
bignum = 1. / smlnum;
/* Scale A if max element outside range [SMLNUM,BIGNUM] */
anrm = lapackf77_zlange( "M", &n, &n, A, &lda, dum );
scalea = 0;
if (anrm > 0. && anrm < smlnum) {
scalea = 1;
cscale = smlnum;
} else if (anrm > bignum) {
scalea = 1;
cscale = bignum;
}
if (scalea) {
lapackf77_zlascl( "G", &c_zero, &c_zero, &anrm, &cscale, &n, &n, A, &lda, &ierr );
}
/* Balance the matrix
* (CWorkspace: none)
* (RWorkspace: need N) */
ibal = 0;
lapackf77_zgebal( "B", &n, A, &lda, &ilo, &ihi, &rwork[ibal], &ierr );
/* Reduce to upper Hessenberg form
* (CWorkspace: need 2*N, prefer N + N*NB)
* (RWorkspace: none) */
itau = 0;
iwrk = itau + n;
liwrk = lwork - iwrk;
#if defined(Version1)
// Version 1 - LAPACK
lapackf77_zgehrd( &n, &ilo, &ihi, A, &lda,
&work[itau], &work[iwrk], &liwrk, &ierr );
#elif defined(Version2)
// Version 2 - LAPACK consistent HRD
magma_zgehrd2( n, ilo, ihi, A, lda,
&work[itau], &work[iwrk], &liwrk, &ierr );
#elif defined(Version3)
// Version 3 - LAPACK consistent MAGMA HRD + matrices T stored,
magma_zgehrd( n, ilo, ihi, A, lda,
&work[itau], &work[iwrk], liwrk, dT, &ierr );
#elif defined(Version4) || defined(Version5)
// Version 4 - Multi-GPU, T on host
magma_zgehrd_m( n, ilo, ihi, A, lda,
&work[itau], &work[iwrk], liwrk, T, &ierr );
magma_zsetmatrix( nb, n, T, nb, dT, nb );
#endif
if (wantvl) {
/* Want left eigenvectors
* Copy Householder vectors to VL */
side[0] = 'L';
lapackf77_zlacpy( MagmaLowerStr, &n, &n, A, &lda, vl, &ldvl );
/* Generate unitary matrix in VL
* (CWorkspace: need 2*N-1, prefer N + (N-1)*NB)
* (RWorkspace: none) */
#if defined(Version1) || defined(Version2)
// Version 1 & 2 - LAPACK
lapackf77_zunghr( &n, &ilo, &ihi, vl, &ldvl, &work[itau],
&work[iwrk], &liwrk, &ierr );
#elif defined(Version3) || defined(Version4)
// Version 3 - LAPACK consistent MAGMA HRD + matrices T stored
magma_zunghr( n, ilo, ihi, vl, ldvl, &work[itau], dT, nb, &ierr );
#elif defined(Version5)
// Version 5 - Multi-GPU, T on host
magma_zunghr_m( n, ilo, ihi, vl, ldvl, &work[itau], T, nb, &ierr );
#endif
/* Perform QR iteration, accumulating Schur vectors in VL
* (CWorkspace: need 1, prefer HSWORK (see comments) )
* (RWorkspace: none) */
iwrk = itau;
liwrk = lwork - iwrk;
lapackf77_zhseqr( "S", "V", &n, &ilo, &ihi, A, &lda, W,
vl, &ldvl, &work[iwrk], &liwrk, info );
if (wantvr) {
/* Want left and right eigenvectors
* Copy Schur vectors to VR */
side[0] = 'B';
lapackf77_zlacpy( "F", &n, &n, vl, &ldvl, vr, &ldvr );
}
}
else if (wantvr) {
/* Want right eigenvectors
* Copy Householder vectors to VR */
side[0] = 'R';
lapackf77_zlacpy( "L", &n, &n, A, &lda, vr, &ldvr );
/* Generate unitary matrix in VR
* (CWorkspace: need 2*N-1, prefer N + (N-1)*NB)
* (RWorkspace: none) */
#if defined(Version1) || defined(Version2)
// Version 1 & 2 - LAPACK
lapackf77_zunghr( &n, &ilo, &ihi, vr, &ldvr, &work[itau],
&work[iwrk], &liwrk, &ierr );
#elif defined(Version3) || defined(Version4)
// Version 3 - LAPACK consistent MAGMA HRD + matrices T stored
magma_zunghr( n, ilo, ihi, vr, ldvr, &work[itau], dT, nb, &ierr );
#elif defined(Version5)
// Version 5 - Multi-GPU, T on host
magma_zunghr_m( n, ilo, ihi, vr, ldvr, &work[itau], T, nb, &ierr );
#endif
/* Perform QR iteration, accumulating Schur vectors in VR
* (CWorkspace: need 1, prefer HSWORK (see comments) )
* (RWorkspace: none) */
iwrk = itau;
liwrk = lwork - iwrk;
lapackf77_zhseqr( "S", "V", &n, &ilo, &ihi, A, &lda, W,
vr, &ldvr, &work[iwrk], &liwrk, info );
}
else {
/* Compute eigenvalues only
* (CWorkspace: need 1, prefer HSWORK (see comments) )
* (RWorkspace: none) */
iwrk = itau;
liwrk = lwork - iwrk;
lapackf77_zhseqr( "E", "N", &n, &ilo, &ihi, A, &lda, W,
vr, &ldvr, &work[iwrk], &liwrk, info );
}
/* If INFO > 0 from ZHSEQR, then quit */
if (*info > 0) {
goto CLEANUP;
}
if (wantvl || wantvr) {
/* Compute left and/or right eigenvectors
* (CWorkspace: need 2*N)
* (RWorkspace: need 2*N) */
irwork = ibal + n;
lapackf77_ztrevc( side, "B", select, &n, A, &lda, vl, &ldvl,
vr, &ldvr, &n, &nout, &work[iwrk], &rwork[irwork], &ierr );
}
if (wantvl) {
/* Undo balancing of left eigenvectors
* (CWorkspace: none)
* (RWorkspace: need N) */
lapackf77_zgebak( "B", "L", &n, &ilo, &ihi, &rwork[ibal], &n,
vl, &ldvl, &ierr );
/* Normalize left eigenvectors and make largest component real */
for (i = 0; i < n; ++i) {
scl = 1. / cblas_dznrm2( n, vl(0,i), 1 );
cblas_zdscal( n, scl, vl(0,i), 1 );
for (k = 0; k < n; ++k) {
/* Computing 2nd power */
d__1 = MAGMA_Z_REAL( *vl(k,i) );
d__2 = MAGMA_Z_IMAG( *vl(k,i) );
rwork[irwork + k] = d__1*d__1 + d__2*d__2;
}
k = cblas_idamax( n, &rwork[irwork], 1 );
z__2 = MAGMA_Z_CNJG( *vl(k,i) );
d__1 = magma_dsqrt( rwork[irwork + k] );
MAGMA_Z_DSCALE( z__1, z__2, d__1 );
tmp = z__1;
cblas_zscal( n, CBLAS_SADDR(tmp), vl(0,i), 1 );
d__1 = MAGMA_Z_REAL( *vl(k,i) );
z__1 = MAGMA_Z_MAKE( d__1, 0 );
*vl(k,i) = z__1;
}
}
if (wantvr) {
/* Undo balancing of right eigenvectors
* (CWorkspace: none)
* (RWorkspace: need N) */
lapackf77_zgebak( "B", "R", &n, &ilo, &ihi, &rwork[ibal], &n,
vr, &ldvr, &ierr );
/* Normalize right eigenvectors and make largest component real */
for (i = 0; i < n; ++i) {
scl = 1. / cblas_dznrm2( n, vr(0,i), 1 );
cblas_zdscal( n, scl, vr(0,i), 1 );
for (k = 0; k < n; ++k) {
/* Computing 2nd power */
d__1 = MAGMA_Z_REAL( *vr(k,i) );
d__2 = MAGMA_Z_IMAG( *vr(k,i) );
rwork[irwork + k] = d__1*d__1 + d__2*d__2;
}
k = cblas_idamax( n, &rwork[irwork], 1 );
z__2 = MAGMA_Z_CNJG( *vr(k,i) );
d__1 = magma_dsqrt( rwork[irwork + k] );
MAGMA_Z_DSCALE( z__1, z__2, d__1 );
tmp = z__1;
cblas_zscal( n, CBLAS_SADDR(tmp), vr(0,i), 1 );
d__1 = MAGMA_Z_REAL( *vr(k,i) );
z__1 = MAGMA_Z_MAKE( d__1, 0 );
*vr(k,i) = z__1;
}
}
CLEANUP:
/* Undo scaling if necessary */
if (scalea) {
i__1 = n - (*info);
i__2 = max( n - (*info), 1 );
lapackf77_zlascl( "G", &c_zero, &c_zero, &cscale, &anrm, &i__1, &c_one,
W + (*info), &i__2, &ierr );
if (*info > 0) {
i__1 = ilo - 1;
lapackf77_zlascl( "G", &c_zero, &c_zero, &cscale, &anrm, &i__1, &c_one,
W, &n, &ierr );
}
}
#if defined(Version3) || defined(Version4) || defined(Version5)
magma_free( dT );
#endif
#if defined(Version4) || defined(Version5)
magma_free_cpu( T );
#endif
return *info;
} /* magma_zgeev */
void
test_scal (void) {
const double flteps = 1e-4, dbleps = 1e-6;
{
int N = 1;
float alpha = 0.0f;
float X[] = { 0.651f };
int incX = -1;
float expected[] = { 0.651f };
cblas_sscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[i], expected[i], flteps, "sscal(case 112)");
}
};
};
{
int N = 1;
float alpha = 0.1f;
float X[] = { 0.651f };
int incX = -1;
float expected[] = { 0.651f };
cblas_sscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[i], expected[i], flteps, "sscal(case 113)");
}
};
};
{
int N = 1;
float alpha = 1.0f;
float X[] = { 0.651f };
int incX = -1;
float expected[] = { 0.651f };
cblas_sscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[i], expected[i], flteps, "sscal(case 114)");
}
};
};
{
int N = 1;
double alpha = 0;
double X[] = { 0.686 };
int incX = -1;
double expected[] = { 0.686 };
cblas_dscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[i], expected[i], dbleps, "dscal(case 115)");
}
};
};
{
int N = 1;
double alpha = 0.1;
double X[] = { 0.686 };
int incX = -1;
double expected[] = { 0.686 };
cblas_dscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[i], expected[i], dbleps, "dscal(case 116)");
}
};
};
{
int N = 1;
double alpha = 1;
double X[] = { 0.686 };
int incX = -1;
double expected[] = { 0.686 };
cblas_dscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[i], expected[i], dbleps, "dscal(case 117)");
}
};
};
{
int N = 1;
float alpha[2] = {0.0f, 0.0f};
float X[] = { 0.986f, -0.775f };
int incX = -1;
float expected[] = { 0.986f, -0.775f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 118) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 118) imag");
};
};
};
{
int N = 1;
float alpha[2] = {0.1f, 0.0f};
float X[] = { 0.986f, -0.775f };
int incX = -1;
float expected[] = { 0.986f, -0.775f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 119) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 119) imag");
};
};
};
{
int N = 1;
float alpha[2] = {1.0f, 0.0f};
float X[] = { 0.986f, -0.775f };
int incX = -1;
float expected[] = { 0.986f, -0.775f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 120) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 120) imag");
};
};
};
{
int N = 1;
float alpha[2] = {0.0f, 0.1f};
float X[] = { 0.986f, -0.775f };
int incX = -1;
float expected[] = { 0.986f, -0.775f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 121) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 121) imag");
};
};
};
{
int N = 1;
float alpha[2] = {0.1f, 0.2f};
float X[] = { 0.986f, -0.775f };
int incX = -1;
float expected[] = { 0.986f, -0.775f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 122) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 122) imag");
};
};
};
{
int N = 1;
float alpha[2] = {1.0f, 0.3f};
float X[] = { 0.986f, -0.775f };
int incX = -1;
float expected[] = { 0.986f, -0.775f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 123) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 123) imag");
};
};
};
{
int N = 1;
double alpha[2] = {0, 0};
double X[] = { 0.454, -0.478 };
int incX = -1;
double expected[] = { 0.454, -0.478 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 124) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 124) imag");
};
};
};
{
int N = 1;
double alpha[2] = {0.1, 0};
double X[] = { 0.454, -0.478 };
int incX = -1;
double expected[] = { 0.454, -0.478 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 125) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 125) imag");
};
};
};
{
int N = 1;
double alpha[2] = {1, 0};
double X[] = { 0.454, -0.478 };
int incX = -1;
double expected[] = { 0.454, -0.478 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 126) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 126) imag");
};
};
};
{
int N = 1;
double alpha[2] = {0, 0.1};
double X[] = { 0.454, -0.478 };
int incX = -1;
double expected[] = { 0.454, -0.478 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 127) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 127) imag");
};
};
};
{
int N = 1;
double alpha[2] = {0.1, 0.2};
double X[] = { 0.454, -0.478 };
int incX = -1;
double expected[] = { 0.454, -0.478 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 128) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 128) imag");
};
};
};
{
int N = 1;
double alpha[2] = {1, 0.3};
double X[] = { 0.454, -0.478 };
int incX = -1;
double expected[] = { 0.454, -0.478 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 1; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 129) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 129) imag");
};
};
};
{
int N = 2;
float alpha = 0.0f;
float X[] = { 0.389f, -0.236f };
int incX = 1;
float expected[] = { 0.0f, -0.0f };
cblas_sscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[i], expected[i], flteps, "sscal(case 130)");
}
};
};
{
int N = 2;
float alpha = 0.1f;
float X[] = { 0.389f, -0.236f };
int incX = 1;
float expected[] = { 0.0389f, -0.0236f };
cblas_sscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[i], expected[i], flteps, "sscal(case 131)");
}
};
};
{
int N = 2;
float alpha = 1.0f;
float X[] = { 0.389f, -0.236f };
int incX = 1;
float expected[] = { 0.389f, -0.236f };
cblas_sscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[i], expected[i], flteps, "sscal(case 132)");
}
};
};
{
int N = 2;
double alpha = 0;
double X[] = { -0.429, -0.183 };
int incX = 1;
double expected[] = { -0.0, -0.0 };
cblas_dscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[i], expected[i], dbleps, "dscal(case 133)");
}
};
};
{
int N = 2;
double alpha = 0.1;
double X[] = { -0.429, -0.183 };
int incX = 1;
double expected[] = { -0.0429, -0.0183 };
cblas_dscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[i], expected[i], dbleps, "dscal(case 134)");
}
};
};
{
int N = 2;
double alpha = 1;
double X[] = { -0.429, -0.183 };
int incX = 1;
double expected[] = { -0.429, -0.183 };
cblas_dscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[i], expected[i], dbleps, "dscal(case 135)");
}
};
};
{
int N = 2;
float alpha[2] = {0.0f, 0.0f};
float X[] = { -0.603f, 0.239f, 0.339f, -0.58f };
int incX = 1;
float expected[] = { -0.0f, 0.0f, 0.0f, 0.0f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 136) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 136) imag");
};
};
};
{
int N = 2;
float alpha[2] = {0.1f, 0.0f};
float X[] = { -0.603f, 0.239f, 0.339f, -0.58f };
int incX = 1;
float expected[] = { -0.0603f, 0.0239f, 0.0339f, -0.058f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 137) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 137) imag");
};
};
};
{
int N = 2;
float alpha[2] = {1.0f, 0.0f};
float X[] = { -0.603f, 0.239f, 0.339f, -0.58f };
int incX = 1;
float expected[] = { -0.603f, 0.239f, 0.339f, -0.58f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 138) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 138) imag");
};
};
};
{
int N = 2;
float alpha[2] = {0.0f, 0.1f};
float X[] = { -0.603f, 0.239f, 0.339f, -0.58f };
int incX = 1;
float expected[] = { -0.0239f, -0.0603f, 0.058f, 0.0339f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 139) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 139) imag");
};
};
};
{
int N = 2;
float alpha[2] = {0.1f, 0.2f};
float X[] = { -0.603f, 0.239f, 0.339f, -0.58f };
int incX = 1;
float expected[] = { -0.1081f, -0.0967f, 0.1499f, 0.0098f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 140) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 140) imag");
};
};
};
{
int N = 2;
float alpha[2] = {1.0f, 0.3f};
float X[] = { -0.603f, 0.239f, 0.339f, -0.58f };
int incX = 1;
float expected[] = { -0.6747f, 0.0581f, 0.513f, -0.4783f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 141) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 141) imag");
};
};
};
{
int N = 2;
double alpha[2] = {0, 0};
double X[] = { -0.956, 0.613, 0.443, 0.503 };
int incX = 1;
double expected[] = { -0.0, 0.0, 0.0, 0.0 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 142) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 142) imag");
};
};
};
{
int N = 2;
double alpha[2] = {0.1, 0};
double X[] = { -0.956, 0.613, 0.443, 0.503 };
int incX = 1;
double expected[] = { -0.0956, 0.0613, 0.0443, 0.0503 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 143) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 143) imag");
};
};
};
{
int N = 2;
double alpha[2] = {1, 0};
double X[] = { -0.956, 0.613, 0.443, 0.503 };
int incX = 1;
double expected[] = { -0.956, 0.613, 0.443, 0.503 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 144) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 144) imag");
};
};
};
{
int N = 2;
double alpha[2] = {0, 0.1};
double X[] = { -0.956, 0.613, 0.443, 0.503 };
int incX = 1;
double expected[] = { -0.0613, -0.0956, -0.0503, 0.0443 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 145) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 145) imag");
};
};
};
{
int N = 2;
double alpha[2] = {0.1, 0.2};
double X[] = { -0.956, 0.613, 0.443, 0.503 };
int incX = 1;
double expected[] = { -0.2182, -0.1299, -0.0563, 0.1389 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 146) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 146) imag");
};
};
};
{
int N = 2;
double alpha[2] = {1, 0.3};
double X[] = { -0.956, 0.613, 0.443, 0.503 };
int incX = 1;
double expected[] = { -1.1399, 0.3262, 0.2921, 0.6359 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 147) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 147) imag");
};
};
};
{
int N = 2;
float alpha = 0.0f;
float X[] = { 0.629f, -0.419f };
int incX = -1;
float expected[] = { 0.629f, -0.419f };
cblas_sscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[i], expected[i], flteps, "sscal(case 148)");
}
};
};
{
int N = 2;
float alpha = 0.1f;
float X[] = { 0.629f, -0.419f };
int incX = -1;
float expected[] = { 0.629f, -0.419f };
cblas_sscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[i], expected[i], flteps, "sscal(case 149)");
}
};
};
{
int N = 2;
float alpha = 1.0f;
float X[] = { 0.629f, -0.419f };
int incX = -1;
float expected[] = { 0.629f, -0.419f };
cblas_sscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[i], expected[i], flteps, "sscal(case 150)");
}
};
};
{
int N = 2;
double alpha = 0;
double X[] = { 0.398, -0.656 };
int incX = -1;
double expected[] = { 0.398, -0.656 };
cblas_dscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[i], expected[i], dbleps, "dscal(case 151)");
}
};
};
{
int N = 2;
double alpha = 0.1;
double X[] = { 0.398, -0.656 };
int incX = -1;
double expected[] = { 0.398, -0.656 };
cblas_dscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[i], expected[i], dbleps, "dscal(case 152)");
}
};
};
{
int N = 2;
double alpha = 1;
double X[] = { 0.398, -0.656 };
int incX = -1;
double expected[] = { 0.398, -0.656 };
cblas_dscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[i], expected[i], dbleps, "dscal(case 153)");
}
};
};
{
int N = 2;
float alpha[2] = {0.0f, 0.0f};
float X[] = { 0.736f, 0.331f, -0.318f, 0.622f };
int incX = -1;
float expected[] = { 0.736f, 0.331f, -0.318f, 0.622f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 154) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 154) imag");
};
};
};
{
int N = 2;
float alpha[2] = {0.1f, 0.0f};
float X[] = { 0.736f, 0.331f, -0.318f, 0.622f };
int incX = -1;
float expected[] = { 0.736f, 0.331f, -0.318f, 0.622f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 155) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 155) imag");
};
};
};
{
int N = 2;
float alpha[2] = {1.0f, 0.0f};
float X[] = { 0.736f, 0.331f, -0.318f, 0.622f };
int incX = -1;
float expected[] = { 0.736f, 0.331f, -0.318f, 0.622f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 156) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 156) imag");
};
};
};
{
int N = 2;
float alpha[2] = {0.0f, 0.1f};
float X[] = { 0.736f, 0.331f, -0.318f, 0.622f };
int incX = -1;
float expected[] = { 0.736f, 0.331f, -0.318f, 0.622f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 157) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 157) imag");
};
};
};
{
int N = 2;
float alpha[2] = {0.1f, 0.2f};
float X[] = { 0.736f, 0.331f, -0.318f, 0.622f };
int incX = -1;
float expected[] = { 0.736f, 0.331f, -0.318f, 0.622f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 158) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 158) imag");
};
};
};
{
int N = 2;
float alpha[2] = {1.0f, 0.3f};
float X[] = { 0.736f, 0.331f, -0.318f, 0.622f };
int incX = -1;
float expected[] = { 0.736f, 0.331f, -0.318f, 0.622f };
cblas_cscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], flteps, "cscal(case 159) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], flteps, "cscal(case 159) imag");
};
};
};
{
int N = 2;
double alpha[2] = {0, 0};
double X[] = { 0.521, -0.811, 0.556, -0.147 };
int incX = -1;
double expected[] = { 0.521, -0.811, 0.556, -0.147 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 160) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 160) imag");
};
};
};
{
int N = 2;
double alpha[2] = {0.1, 0};
double X[] = { 0.521, -0.811, 0.556, -0.147 };
int incX = -1;
double expected[] = { 0.521, -0.811, 0.556, -0.147 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 161) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 161) imag");
};
};
};
{
int N = 2;
double alpha[2] = {1, 0};
double X[] = { 0.521, -0.811, 0.556, -0.147 };
int incX = -1;
double expected[] = { 0.521, -0.811, 0.556, -0.147 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 162) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 162) imag");
};
};
};
{
int N = 2;
double alpha[2] = {0, 0.1};
double X[] = { 0.521, -0.811, 0.556, -0.147 };
int incX = -1;
double expected[] = { 0.521, -0.811, 0.556, -0.147 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 163) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 163) imag");
};
};
};
{
int N = 2;
double alpha[2] = {0.1, 0.2};
double X[] = { 0.521, -0.811, 0.556, -0.147 };
int incX = -1;
double expected[] = { 0.521, -0.811, 0.556, -0.147 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 164) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 164) imag");
};
};
};
{
int N = 2;
double alpha[2] = {1, 0.3};
double X[] = { 0.521, -0.811, 0.556, -0.147 };
int incX = -1;
double expected[] = { 0.521, -0.811, 0.556, -0.147 };
cblas_zscal(N, alpha, X, incX);
{
int i;
for (i = 0; i < 2; i++) {
gsl_test_rel(X[2*i], expected[2*i], dbleps, "zscal(case 165) real");
gsl_test_rel(X[2*i+1], expected[2*i+1], dbleps, "zscal(case 165) imag");
};
};
};
}
void F77_zscal(const int *N, const void * *alpha, void *X,
const int *incX)
{
cblas_zscal(*N, alpha, X, *incX);
return;
}
void HostVector<std::complex<double> >::Scale(const std::complex<double> alpha) {
cblas_zscal(this->size_, &alpha, this->vec_, 1);
}
VALUE rb_blas_xscal_mod(int argc, VALUE *argv, VALUE self)
{
Matrix *dx;
int incx;
int n;
float da_f;
double da_d;
float da_c[2];
double da_z[2];
//char error_msg[64];
VALUE da_value, n_value, incx_value;
rb_scan_args(argc, argv, "12", &da_value, &incx_value, &n_value);
Data_Get_Struct(self, Matrix, dx);
if(incx_value == Qnil)
incx = 1;
else
incx = NUM2INT(incx_value);
if(n_value == Qnil)
n = dx->nrows;
else
n = NUM2INT(n_value);
if(dx == NULL || dx->ncols != 1)
{ //sprintf(error_msg, "Self is not a Vector");
rb_raise(rb_eRuntimeError, "Self is not a Vector");
}
switch(dx->data_type)
{
case Single_t: //s
if(da_value == Qnil)
da_f = (float) 1.0;
else
da_f = (float) NUM2DBL(da_value);
cblas_sscal(n , da_f, (float *)dx->data, incx );
break;
case Double_t: //d
if(da_value == Qnil)
da_d = (double) 1.0;
else
da_d = NUM2DBL(da_value);
cblas_dscal(n , da_d, (double *)dx->data, incx );
break;
case Complex_t: //c
if(da_value == Qnil)
{
da_c[0] = (float) 1.0;
da_c[1] = (float) 0.0;
}
else
{
da_c[0] = (float) NUM2DBL(rb_funcall( rb_intern("Complex"), rb_intern("real"), 1, da_value) );
da_c[1] = (float) NUM2DBL(rb_funcall(rb_intern("Complex"), rb_intern("image"), 1, da_value ) );
}
cblas_cscal(n , da_c, dx->data, incx );
break;
case Double_Complex_t: //z
if(da_value == Qnil)
{
da_z[0] = (double) 1.0;
da_z[1] = (double) 0.0;
}
else
{
da_z[0] = NUM2DBL(rb_funcall( rb_intern("Complex"), rb_intern("real"), 1, da_value) );
da_z[1] = NUM2DBL(rb_funcall(rb_intern("Complex"), rb_intern("image"), 1, da_value ) );
}
cblas_zscal(n , da_z, dx->data, incx );
break;
default:
//sprintf(error_msg, "Invalid data_type (%d) in Matrix", dx->data_type);
rb_raise(rb_eRuntimeError, "Invalid data_type (%d) in Matrix", dx->data_type);
break; //Never reaches here.
}
return self;
}
DLLEXPORT void z_scale(const blasint n, const openblas_complex_double alpha, openblas_complex_double x[]) {
cblas_zscal(n, (double*)&alpha, (double*)x, 1);
}
void CBlasMath::ifft(Matrix *a)
{
fft(a, FFTW_BACKWARD);
std::complex<double> N(1.0/(a->getRows()*a->getCols()));
cblas_zscal(a->getRows()*a->getCols(), &N, a->data(), 1);
}
void CBlasMath::mult(Matrix *a, std::complex<double> s)
{
cblas_zscal(a->getRows() * a->getCols(), &s, a->data(), 1);
}
/***************************************************************************//**
*
* @ingroup CORE_PLASMA_Complex64_t
*
* CORE_zgetf2_nopiv computes an LU factorization of a general diagonal
* dominant M-by-N matrix A witout no pivoting and no blocking. It is the
* internal function called by CORE_zgetrf_nopiv().
*
* The factorization has the form
* A = L * U
* where L is lower triangular with unit
* diagonal elements (lower trapezoidal if m > n), and U is upper
* triangular (upper trapezoidal if m < n).
*
* This is the right-looking Level 3 BLAS version of the algorithm.
*
*******************************************************************************
*
* @param[in] M
* The number of rows of the matrix A. M >= 0.
*
* @param[in] N
* The number of columns of the matrix A. N >= 0.
*
* @param[in,out] A
* On entry, the M-by-N matrix to be factored.
* On exit, the factors L and U from the factorization
* A = P*L*U; the unit diagonal elements of L are not stored.
*
* @param[in] LDA
* The leading dimension of the array A. LDA >= max(1,M).
*
*******************************************************************************
*
* @return
* \retval PLASMA_SUCCESS successful exit
* \retval <0 if INFO = -k, the k-th argument had an illegal value
* \retval >0 if INFO = k, U(k,k) is exactly zero. The factorization
* has been completed, but the factor U is exactly
* singular, and division by zero will occur if it is used
* to solve a system of equations.
*
******************************************************************************/
int
CORE_zgetf2_nopiv(int M, int N,
PLASMA_Complex64_t *A, int LDA)
{
PLASMA_Complex64_t mzone = (PLASMA_Complex64_t)-1.0;
PLASMA_Complex64_t alpha;
double sfmin;
int i, j, k;
int info;
/* Check input arguments */
info = 0;
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 ((LDA < max(1,M)) && (M > 0)) {
coreblas_error(5, "Illegal value of LDA");
return -5;
}
/* Quick return */
if ( (M == 0) || (N == 0) )
return PLASMA_SUCCESS;
sfmin = LAPACKE_dlamch_work('S');
k = min(M, N);
for(i=0 ; i < k; i++) {
alpha = A[i*LDA+i];
if ( alpha != (PLASMA_Complex64_t)0.0 ) {
/* Compute elements J+1:M of J-th column. */
if (i < M) {
if ( cabs(alpha) > sfmin ) {
alpha = 1.0 / alpha;
cblas_zscal( M-i-1, CBLAS_SADDR(alpha), &(A[i*LDA+i+1]), 1);
} else {
for(j=i+1; j<M; j++)
A[LDA*i+j] = A[LDA*i+j] / alpha;
}
}
} else if ( info == 0 ) {
info = i;
goto end;
}
if ( i < k ) {
/* Update trailing submatrix */
cblas_zgeru(CblasColMajor,
M-i-1, N-i-1, CBLAS_SADDR(mzone),
&A[LDA* i +i+1], 1,
&A[LDA*(i+1)+i ], LDA,
&A[LDA*(i+1)+i+1], LDA);
}
}
end:
return info;
}
