static void magma_stile_bulge_computeT_parallel(magma_int_t my_core_id, magma_int_t cores_num, float *V, magma_int_t ldv, float *TAU,
float *T, magma_int_t ldt, magma_int_t n, magma_int_t nb, magma_int_t Vblksiz)
{
//%===========================
//% local variables
//%===========================
magma_int_t firstcolj;
magma_int_t rownbm;
magma_int_t st,ed,fst,vlen,vnb,colj;
magma_int_t blkid,vpos,taupos,tpos;
magma_int_t blkpercore, myid;
if(n<=0)
return ;
magma_int_t blkcnt = magma_bulge_get_blkcnt(n, nb, Vblksiz);
blkpercore = blkcnt/cores_num;
magma_int_t nbGblk = magma_ceildiv(n-1, Vblksiz);
if(my_core_id==0) printf(" COMPUTE T parallel threads %d with N %d NB %d Vblksiz %d \n",cores_num,n,nb,Vblksiz);
for (magma_int_t bg = nbGblk; bg>0; bg--)
{
firstcolj = (bg-1)*Vblksiz + 1;
rownbm = magma_ceildiv(n-(firstcolj+1), nb);
if(bg==nbGblk)
rownbm = magma_ceildiv(n-firstcolj ,nb); // last blk has size=1 used for real to handle A(N,N-1)
for (magma_int_t m = rownbm; m>0; m--)
{
vlen = 0;
vnb = 0;
colj = (bg-1)*Vblksiz; // for k=0;I compute the fst and then can remove it from the loop
fst = (rownbm -m)*nb+colj +1;
for (magma_int_t k=0; k<Vblksiz; k++)
{
colj = (bg-1)*Vblksiz + k;
st = (rownbm -m)*nb+colj +1;
ed = min(st+nb-1,n-1);
if(st>ed)
break;
if((st==ed)&&(colj!=n-2))
break;
vlen=ed-fst+1;
vnb=k+1;
}
colj = (bg-1)*Vblksiz;
magma_bulge_findVTAUTpos(n, nb, Vblksiz, colj, fst, ldv, ldt, &vpos, &taupos, &tpos, &blkid);
myid = blkid/blkpercore;
if(my_core_id==(myid%cores_num)){
if((vlen>0)&&(vnb>0))
lapackf77_slarft( "F", "C", &vlen, &vnb, V(vpos), &ldv, TAU(taupos), T(tpos), &ldt);
}
}
}
}
magma_int_t magma_zbulge_get_lq2(magma_int_t n, magma_int_t threads)
{
magma_int_t nb = magma_get_zbulge_nb(n, threads);
magma_int_t Vblksiz = magma_zbulge_get_Vblksiz(n, nb, threads);
magma_int_t ldv = nb + Vblksiz;
magma_int_t ldt = Vblksiz;
return magma_bulge_get_blkcnt(n, nb, Vblksiz) * Vblksiz * (ldt + ldv + 1);
}
extern "C" magma_int_t
magma_zbulge_getstg2size(magma_int_t n, magma_int_t nb, magma_int_t wantz,
magma_int_t Vblksiz, magma_int_t ldv, magma_int_t ldt,
magma_int_t *blkcnt, magma_int_t *sizTAU2,
magma_int_t *sizT2, magma_int_t *sizV2)
{
blkcnt[0] = magma_bulge_get_blkcnt(n, nb, Vblksiz);
sizTAU2[0] = wantz == 0 ? 2*n : blkcnt[0]*Vblksiz;
sizV2[0] = wantz == 0 ? 2*n : blkcnt[0]*Vblksiz*ldv;
sizT2[0] = wantz == 0 ? 0 : blkcnt[0]*Vblksiz*ldt;
return sizTAU2[0] + sizT2[0] + sizV2[0];
}
extern "C" magma_int_t
magma_get_zbulge_lq2(magma_int_t n, magma_int_t threads, magma_int_t wantz)
{
if (wantz == 0)
return 2*n*2;
magma_int_t nb = magma_get_zbulge_nb(n, threads);
magma_int_t Vblksiz = magma_get_zbulge_vblksiz(n, nb, threads);
magma_int_t ldv = nb + Vblksiz;
magma_int_t ldt = Vblksiz;
return magma_bulge_get_blkcnt(n, nb, Vblksiz) * Vblksiz * (ldt + ldv + 1);
}
extern "C" magma_int_t
magma_ssyevdx_2stage(char jobz, char range, char uplo,
magma_int_t n,
float *a, magma_int_t lda,
float vl, float vu, magma_int_t il, magma_int_t iu,
magma_int_t *m, float *w,
float *work, magma_int_t lwork,
magma_int_t *iwork, magma_int_t liwork,
magma_int_t *info)
{
/* -- MAGMA (version 1.4.1) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
December 2013
Purpose
=======
ZHEEVD_2STAGE computes all eigenvalues and, optionally, eigenvectors of a
complex Hermitian matrix A. It uses a two-stage algorithm for the tridiagonalization.
If eigenvectors are desired, it uses a divide and conquer algorithm.
The divide and conquer algorithm makes very mild assumptions about
floating point arithmetic. It will work on machines with a guard
digit in add/subtract, or on those binary machines without guard
digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
Cray-2. It could conceivably fail on hexadecimal or decimal machines
without guard digits, but we know of none.
Arguments
=========
JOBZ (input) CHARACTER*1
= 'N': Compute eigenvalues only;
= 'V': Compute eigenvalues and eigenvectors.
RANGE (input) CHARACTER*1
= 'A': all eigenvalues will be found.
= 'V': all eigenvalues in the half-open interval (VL,VU]
will be found.
= 'I': the IL-th through IU-th eigenvalues will be found.
UPLO (input) CHARACTER*1
= 'U': Upper triangle of A is stored;
= 'L': Lower triangle of A is stored.
N (input) INTEGER
The order of the matrix A. N >= 0.
A (input/output) COMPLEX_16 array, dimension (LDA, N)
On entry, the Hermitian matrix A. If UPLO = 'U', the
leading N-by-N upper triangular part of A contains the
upper triangular part of the matrix A. If UPLO = 'L',
the leading N-by-N lower triangular part of A contains
the lower triangular part of the matrix A.
On exit, if JOBZ = 'V', then if INFO = 0, the first m columns
of A contains the required
orthonormal eigenvectors of the matrix A.
If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
or the upper triangle (if UPLO='U') of A, including the
diagonal, is destroyed.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
VL (input) REAL
VU (input) REAL
If RANGE='V', the lower and upper bounds of the interval to
be searched for eigenvalues. VL < VU.
Not referenced if RANGE = 'A' or 'I'.
IL (input) INTEGER
IU (input) INTEGER
If RANGE='I', the indices (in ascending order) of the
smallest and largest eigenvalues to be returned.
1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
Not referenced if RANGE = 'A' or 'V'.
M (output) INTEGER
The total number of eigenvalues found. 0 <= M <= N.
If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
W (output) REAL array, dimension (N)
If INFO = 0, the required m eigenvalues in ascending order.
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 length of the array WORK.
If N <= 1, LWORK >= 1.
If JOBZ = 'N' and N > 1, LWORK >= LQ2 + N * (NB + 2).
If JOBZ = 'V' and N > 1, LWORK >= LQ2 + 1 + 6*N + 2*N**2.
where LQ2 is the size needed to store
the Q2 matrix and is returned by
MAGMA_BULGE_GET_LQ2.
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal sizes of the WORK, RWORK and
IWORK arrays, returns these values as the first entries of
the WORK, RWORK and IWORK arrays, and no error message
related to LWORK or LRWORK or LIWORK is issued by XERBLA.
IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
LIWORK (input) INTEGER
The dimension of the array IWORK.
If N <= 1, LIWORK >= 1.
If JOBZ = 'N' and N > 1, LIWORK >= 1.
If JOBZ = 'V' and N > 1, LIWORK >= 3 + 5*N.
If LIWORK = -1, then a workspace query is assumed; the
routine only calculates the optimal sizes of the WORK, RWORK
and IWORK arrays, returns these values as the first entries
of the WORK, RWORK and IWORK arrays, and no error message
related to LWORK or LRWORK or LIWORK is issued by XERBLA.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
> 0: if INFO = i and JOBZ = 'N', then the algorithm failed
to converge; i off-diagonal elements of an intermediate
tridiagonal form did not converge to zero;
if INFO = i and JOBZ = 'V', then the algorithm failed
to compute an eigenvalue while working on the submatrix
lying in rows and columns INFO/(N+1) through
mod(INFO,N+1).
Further Details
===============
Based on contributions by
Jeff Rutter, Computer Science Division, University of California
at Berkeley, USA
Modified description of INFO. Sven, 16 Feb 05.
===================================================================== */
char uplo_[2] = {uplo, 0};
char jobz_[2] = {jobz, 0};
char range_[2] = {range, 0};
float d_one = 1.;
magma_int_t ione = 1;
magma_int_t izero = 0;
float d__1;
float eps;
float anrm;
magma_int_t imax;
float rmin, rmax;
float sigma;
magma_int_t lwmin, liwmin;
magma_int_t lower;
magma_int_t wantz;
magma_int_t iscale;
float safmin;
float bignum;
float smlnum;
magma_int_t lquery;
magma_int_t alleig, valeig, indeig;
float* dwork;
/* determine the number of threads */
magma_int_t threads = magma_get_numthreads();
magma_setlapack_numthreads(threads);
wantz = lapackf77_lsame(jobz_, MagmaVecStr);
lower = lapackf77_lsame(uplo_, MagmaLowerStr);
alleig = lapackf77_lsame( range_, "A" );
valeig = lapackf77_lsame( range_, "V" );
indeig = lapackf77_lsame( range_, "I" );
lquery = lwork == -1 || liwork == -1;
*info = 0;
if (! (wantz || lapackf77_lsame(jobz_, MagmaNoVecStr))) {
*info = -1;
} else if (! (alleig || valeig || indeig)) {
*info = -2;
} else if (! (lower || lapackf77_lsame(uplo_, MagmaUpperStr))) {
*info = -3;
} else if (n < 0) {
*info = -4;
} else if (lda < max(1,n)) {
*info = -6;
} else {
if (valeig) {
if (n > 0 && vu <= vl) {
*info = -8;
}
} else if (indeig) {
if (il < 1 || il > max(1,n)) {
*info = -9;
} else if (iu < min(n,il) || iu > n) {
*info = -10;
}
}
}
magma_int_t nb = magma_get_sbulge_nb(n, threads);
magma_int_t Vblksiz = magma_sbulge_get_Vblksiz(n, nb, threads);
magma_int_t ldt = Vblksiz;
magma_int_t ldv = nb + Vblksiz;
magma_int_t blkcnt = magma_bulge_get_blkcnt(n, nb, Vblksiz);
magma_int_t lq2 = magma_sbulge_get_lq2(n, threads);
if (wantz) {
lwmin = lq2 + 1 + 6 * n + 2 * n * n;
liwmin = 5 * n + 3;
} else {
lwmin = lq2 + n * (nb + 1);
liwmin = 1;
}
work[0] = lwmin * (1. + lapackf77_slamch("Epsilon"));
iwork[0] = liwmin;
if ((lwork < lwmin) && !lquery) {
*info = -14;
} else if ((liwork < liwmin) && ! lquery) {
*info = -16;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery) {
return *info;
}
/* Quick return if possible */
if (n == 0) {
return *info;
}
if (n == 1) {
w[0] = a[0];
if (wantz) {
a[0] = MAGMA_S_ONE;
}
return *info;
}
#ifdef ENABLE_TIMER
printf("using %d threads\n", threads);
#endif
/* Check if matrix is very small then just call LAPACK on CPU, no need for GPU */
magma_int_t ntiles = n/nb;
if( ( ntiles < 2 ) || ( n <= 128 ) ){
#ifdef ENABLE_DEBUG
printf("--------------------------------------------------------------\n");
printf(" warning matrix too small N=%d NB=%d, calling lapack on CPU \n", (int) n, (int ) nb);
printf("--------------------------------------------------------------\n");
#endif
lapackf77_ssyevd(jobz_, uplo_, &n,
a, &lda, w,
work, &lwork,
iwork, &liwork,
info);
*m = n;
return *info;
}
/* Get machine constants. */
safmin = lapackf77_slamch("Safe minimum");
eps = lapackf77_slamch("Precision");
smlnum = safmin / eps;
bignum = 1. / smlnum;
rmin = magma_ssqrt(smlnum);
rmax = magma_ssqrt(bignum);
/* Scale matrix to allowable range, if necessary. */
anrm = lapackf77_slansy("M", uplo_, &n, a, &lda, work);
iscale = 0;
if (anrm > 0. && anrm < rmin) {
iscale = 1;
sigma = rmin / anrm;
} else if (anrm > rmax) {
iscale = 1;
sigma = rmax / anrm;
}
if (iscale == 1) {
lapackf77_slascl(uplo_, &izero, &izero, &d_one, &sigma, &n, &n, a,
&lda, info);
}
magma_int_t inde = 0;
magma_int_t indT2 = inde + n;
magma_int_t indTAU2 = indT2 + blkcnt*ldt*Vblksiz;
magma_int_t indV2 = indTAU2+ blkcnt*Vblksiz;
magma_int_t indtau1 = indV2 + blkcnt*ldv*Vblksiz;
magma_int_t indwrk = indtau1+ n;
magma_int_t indwk2 = indwrk + n * n;
magma_int_t llwork = lwork - indwrk;
magma_int_t llwrk2 = lwork - indwk2;
#ifdef ENABLE_TIMER
magma_timestr_t start, st1, st2, end;
start = get_current_time();
#endif
float *dT1;
if (MAGMA_SUCCESS != magma_smalloc( &dT1, n*nb)) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
magma_ssytrd_sy2sb(uplo, n, nb, a, lda, &work[indtau1], &work[indwrk], llwork, dT1, threads, info);
#ifdef ENABLE_TIMER
st1 = get_current_time();
printf(" time ssytrd_sy2sb = %6.2f\n" , GetTimerValue(start,st1)/1000.);
#endif
/* copy the input matrix into WORK(INDWRK) with band storage */
/* PAY ATTENTION THAT work[indwrk] should be able to be of size lda2*n which it should be checked in any future modification of lwork.*/
magma_int_t lda2 = 2*nb; //nb+1+(nb-1);
float* A2 = &work[indwrk];
memset(A2 , 0, n*lda2*sizeof(float));
for (magma_int_t j = 0; j < n-nb; j++)
{
cblas_scopy(nb+1, &a[j*(lda+1)], 1, &A2[j*lda2], 1);
memset(&a[j*(lda+1)], 0, (nb+1)*sizeof(float));
a[nb + j*(lda+1)] = d_one;
}
for (magma_int_t j = 0; j < nb; j++)
{
cblas_scopy(nb-j, &a[(j+n-nb)*(lda+1)], 1, &A2[(j+n-nb)*lda2], 1);
memset(&a[(j+n-nb)*(lda+1)], 0, (nb-j)*sizeof(float));
}
#ifdef ENABLE_TIMER
st2 = get_current_time();
printf(" time ssytrd_convert = %6.2f\n" , GetTimerValue(st1,st2)/1000.);
#endif
magma_ssytrd_sb2st(threads, uplo, n, nb, Vblksiz, A2, lda2, w, &work[inde], &work[indV2], ldv, &work[indTAU2], wantz, &work[indT2], ldt);
#ifdef ENABLE_TIMER
end = get_current_time();
printf(" time ssytrd_sy2st = %6.2f\n" , GetTimerValue(st2,end)/1000.);
printf(" time ssytrd = %6.2f\n", GetTimerValue(start,end)/1000.);
#endif
/* For eigenvalues only, call SSTERF. For eigenvectors, first call
ZSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
tridiagonal matrix, then call ZUNMTR to multiply it to the Householder
transformations represented as Householder vectors in A. */
if (! wantz) {
#ifdef ENABLE_TIMER
start = get_current_time();
#endif
lapackf77_ssterf(&n, w, &work[inde], info);
magma_smove_eig(range, n, w, &il, &iu, vl, vu, m);
#ifdef ENABLE_TIMER
end = get_current_time();
printf(" time sstedc = %6.2f\n", GetTimerValue(start,end)/1000.);
#endif
} else {
#ifdef ENABLE_TIMER
start = get_current_time();
#endif
if (MAGMA_SUCCESS != magma_smalloc( &dwork, 3*n*(n/2 + 1) )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
magma_sstedx(range, n, vl, vu, il, iu, w, &work[inde],
&work[indwrk], n, &work[indwk2],
llwrk2, iwork, liwork, dwork, info);
magma_free( dwork );
#ifdef ENABLE_TIMER
end = get_current_time();
printf(" time sstedx = %6.2f\n", GetTimerValue(start,end)/1000.);
start = get_current_time();
#endif
float *dZ;
magma_int_t lddz = n;
float *da;
magma_int_t ldda = n;
magma_smove_eig(range, n, w, &il, &iu, vl, vu, m);
if (MAGMA_SUCCESS != magma_smalloc( &dZ, *m*lddz)) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
if (MAGMA_SUCCESS != magma_smalloc( &da, n*ldda )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
magma_sbulge_back(threads, uplo, n, nb, *m, Vblksiz, &work[indwrk + n * (il-1)], n, dZ, lddz,
&work[indV2], ldv, &work[indTAU2], &work[indT2], ldt, info);
#ifdef ENABLE_TIMER
st1 = get_current_time();
printf(" time sbulge_back = %6.2f\n" , GetTimerValue(start,st1)/1000.);
#endif
magma_ssetmatrix( n, n, a, lda, da, ldda );
magma_sormqr_gpu_2stages(MagmaLeft, MagmaNoTrans, n-nb, *m, n-nb, da+nb, ldda,
dZ+nb, n, dT1, nb, info);
magma_sgetmatrix( n, *m, dZ, lddz, a, lda );
magma_free(dT1);
magma_free(dZ);
magma_free(da);
#ifdef ENABLE_TIMER
end = get_current_time();
printf(" time sormqr + copy = %6.2f\n", GetTimerValue(st1,end)/1000.);
printf(" time eigenvectors backtransf. = %6.2f\n" , GetTimerValue(start,end)/1000.);
#endif
}
/* If matrix was scaled, then rescale eigenvalues appropriately. */
if (iscale == 1) {
if (*info == 0) {
imax = n;
} else {
imax = *info - 1;
}
d__1 = 1. / sigma;
blasf77_sscal(&imax, &d__1, w, &ione);
}
work[0] = lwmin * (1. + lapackf77_slamch("Epsilon"));
iwork[0] = liwmin;
return *info;
} /* magma_zheevdx_2stage */
static void magma_stile_bulge_computeT_parallel(magma_int_t my_core_id, magma_int_t cores_num, float *V, magma_int_t ldv, float *TAU,
float *T, magma_int_t ldt, magma_int_t n, magma_int_t nb, magma_int_t Vblksiz)
{
//%===========================
//% local variables
//%===========================
magma_int_t Vm, Vn, mt, nt;
magma_int_t myrow, mycol, blkj, blki, firstrow;
magma_int_t blkid,vpos,taupos,tpos;
magma_int_t blkpercore, myid;
if(n<=0)
return ;
magma_int_t blkcnt = magma_bulge_get_blkcnt(n, nb, Vblksiz);
blkpercore = blkcnt/cores_num;
blkpercore = blkpercore==0 ? 1:blkpercore;
//magma_int_t nbGblk = magma_ceildiv(n-1, Vblksiz);
#ifdef ENABLE_DEBUG
if(my_core_id==0)
printf(" COMPUTE T parallel threads %d with N %d NB %d Vblksiz %d \n",cores_num,n,nb,Vblksiz);
#endif
/*========================================
* compute the T's in parallel.
* The Ts are independent so each core pick
* a T and compute it. The loop is based on
* the version 113 of the applyQ
* which go over the losange block_column
* by block column. but it is not important
* here the order because Ts are independent.
* ========================================
*/
nt = magma_ceildiv((n-1),Vblksiz);
for (blkj=nt-1; blkj>=0; blkj--) {
/* the index of the first row on the top of block (blkj) */
firstrow = blkj * Vblksiz + 1;
/*find the number of tile for this block */
if( blkj == nt-1 )
mt = magma_ceildiv( n - firstrow, nb);
else
mt = magma_ceildiv( n - (firstrow+1), nb);
/*loop over the tiles find the size of the Vs and apply it */
for (blki=mt; blki>0; blki--) {
/*calculate the size of each losange of Vs= (Vm,Vn)*/
myrow = firstrow + (mt-blki)*nb;
mycol = blkj*Vblksiz;
Vm = min( nb+Vblksiz-1, n-myrow);
if( ( blkj == nt-1 ) && ( blki == mt ) ){
Vn = min (Vblksiz, Vm);
} else {
Vn = min (Vblksiz, Vm-1);
}
/*calculate the pointer to the Vs and the Ts.
* Note that Vs and Ts have special storage done
* by the bulgechasing function*/
magma_bulge_findVTAUTpos(n, nb, Vblksiz, mycol, myrow, ldv, ldt, &vpos, &taupos, &tpos, &blkid);
myid = blkid/blkpercore;
if( my_core_id==(myid%cores_num) ){
if( ( Vm > 0 ) && ( Vn > 0 ) ){
lapackf77_slarft( "F", "C", &Vm, &Vn, V(vpos), &ldv, TAU(taupos), T(tpos), &ldt);
}
}
}
}
}
extern "C" magma_int_t magma_ssytrd_sb2st(magma_int_t threads, char uplo, magma_int_t n, magma_int_t nb, magma_int_t Vblksiz,
float *A, magma_int_t lda, float *D, float *E,
float *V, magma_int_t ldv, float *TAU, magma_int_t compT, float *T, magma_int_t ldt)
{
/* -- MAGMA (version 1.4.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
August 2013
Purpose
=======
Arguments
=========
THREADS (input) INTEGER
Specifies the number of pthreads used.
THREADS > 0
UPLO (input) CHARACTER*1
= 'U': Upper triangles of A is stored;
= 'L': Lower triangles of A is stored.
N (input) INTEGER
The order of the matrix A. N >= 0.
NB (input) INTEGER
The order of the band matrix A. N >= NB >= 0.
VBLKSIZ (input) INTEGER
The size of the block of householder vectors applied at once.
A (input/workspace) REAL array, dimension (LDA, N)
On entry the band matrix stored in the following way:
LDA (input) INTEGER
The leading dimension of the array A. LDA >= 2*NB.
D (output) DOUBLE array, dimension (N)
The diagonal elements of the tridiagonal matrix T:
D(i) = A(i,i).
E (output) DOUBLE array, dimension (N-1)
The off-diagonal elements of the tridiagonal matrix T:
E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
V (output) REAL array, dimension (BLKCNT, LDV, VBLKSIZ)
On exit it contains the blocks of householder reflectors
BLKCNT is the number of block and it is returned by the funtion MAGMA_BULGE_GET_BLKCNT.
LDV (input) INTEGER
The leading dimension of V.
LDV > NB + VBLKSIZ + 1
TAU (output) REAL dimension(BLKCNT, VBLKSIZ)
???
COMPT (input) INTEGER
if COMPT = 0 T is not computed
if COMPT = 1 T is computed
T (output) REAL dimension(LDT *)
if COMPT = 1 on exit contains the matrices T needed for Q2
if COMPT = 0 T is not referenced
LDT (input) INTEGER
The leading dimension of T.
LDT > Vblksiz
INFO (output) INTEGER ????????????????????????????????????????????????????????????????????????????????????
= 0: successful exit
===================================================================== */
#ifdef ENABLE_TIMER
real_Double_t timeblg=0.0;
#endif
//char uplo_[2] = {uplo, 0};
magma_int_t mklth = threads;
magma_int_t INgrsiz=1;
magma_int_t blkcnt = magma_bulge_get_blkcnt(n, nb, Vblksiz);
magma_int_t nbtiles = magma_ceildiv(n, nb);
memset(T, 0, blkcnt*ldt*Vblksiz*sizeof(float));
memset(TAU, 0, blkcnt*Vblksiz*sizeof(float));
memset(V, 0, blkcnt*ldv*Vblksiz*sizeof(float));
magma_int_t* prog;
magma_malloc_cpu((void**) &prog, (2*nbtiles+threads+10)*sizeof(magma_int_t));
memset(prog, 0, (2*nbtiles+threads+10)*sizeof(magma_int_t));
magma_sbulge_id_data* arg;
magma_malloc_cpu((void**) &arg, threads*sizeof(magma_sbulge_id_data));
pthread_t* thread_id;
magma_malloc_cpu((void**) &thread_id, threads*sizeof(pthread_t));
pthread_attr_t thread_attr;
magma_setlapack_numthreads(1);
magma_sbulge_data data_bulge(threads, n, nb, nbtiles, INgrsiz, Vblksiz, compT,
A, lda, V, ldv, TAU, T, ldt, prog);
// Set one thread per core
pthread_attr_init(&thread_attr);
pthread_attr_setscope(&thread_attr, PTHREAD_SCOPE_SYSTEM);
pthread_setconcurrency(threads);
//timing
#ifdef ENABLE_TIMER
timeblg = magma_wtime();
#endif
// Launch threads
for (magma_int_t thread = 1; thread < threads; thread++)
{
arg[thread] = magma_sbulge_id_data(thread, &data_bulge);
pthread_create(&thread_id[thread], &thread_attr, magma_ssytrd_sb2st_parallel_section, &arg[thread]);
}
arg[0] = magma_sbulge_id_data(0, &data_bulge);
magma_ssytrd_sb2st_parallel_section(&arg[0]);
// Wait for completion
for (magma_int_t thread = 1; thread < threads; thread++)
{
void *exitcodep;
pthread_join(thread_id[thread], &exitcodep);
}
// timing
#ifdef ENABLE_TIMER
timeblg = magma_wtime()-timeblg;
printf(" time BULGE+T = %f \n" ,timeblg);
#endif
magma_free_cpu(thread_id);
magma_free_cpu(arg);
magma_free_cpu(prog);
magma_setlapack_numthreads(mklth);
/*================================================
* store resulting diag and lower diag D and E
* note that D and E are always real
*================================================*/
/* Make diagonal and superdiagonal elements real,
* storing them in D and E
*/
/* In real case, the off diagonal element are
* not necessary real. we have to make off-diagonal
* elements real and copy them to E.
* When using HouseHolder elimination,
* the SLARFG give us a real as output so, all the
* diagonal/off-diagonal element except the last one are already
* real and thus we need only to take the abs of the last
* one.
* */
#if defined(PRECISION_z) || defined(PRECISION_c)
if(uplo==MagmaLower){
for (magma_int_t i=0; i < n-1 ; i++)
{
D[i] = MAGMA_S_REAL(A[i*lda ]);
E[i] = MAGMA_S_REAL(A[i*lda+1]);
}
D[n-1] = MAGMA_S_REAL(A[(n-1)*lda]);
} else { /* MagmaUpper not tested yet */
for (magma_int_t i=0; i<n-1; i++)
{
D[i] = MAGMA_S_REAL(A[i*lda+nb]);
E[i] = MAGMA_S_REAL(A[i*lda+nb-1]);
}
D[n-1] = MAGMA_S_REAL(A[(n-1)*lda+nb]);
} /* end MagmaUpper */
#else
if( uplo == MagmaLower ){
for (magma_int_t i=0; i < n-1; i++) {
D[i] = A[i*lda]; // diag
E[i] = A[i*lda+1]; //lower diag
}
D[n-1] = A[(n-1)*lda];
} else {
for (magma_int_t i=0; i < n-1; i++) {
D[i] = A[i*lda+nb]; // diag
E[i] = A[i*lda+nb-1]; //lower diag
}
D[n-1] = A[(n-1)*lda+nb];
}
#endif
return MAGMA_SUCCESS;
}
/**
Purpose
-------
Arguments
---------
@param[in]
uplo magma_uplo_t
- = MagmaUpper: Upper triangles of A is stored;
- = MagmaLower: Lower triangles of A is stored.
@param[in]
n INTEGER
The order of the matrix A. N >= 0.
@param[in]
nb INTEGER
The order of the band matrix A. N >= NB >= 0.
@param[in]
Vblksiz INTEGER
The size of the block of householder vectors applied at once.
@param[in]
A (workspace) COMPLEX_16 array, dimension (LDA, N)
On entry the band matrix stored in the following way:
@param[in]
lda INTEGER
The leading dimension of the array A. LDA >= 2*NB.
@param[out]
d DOUBLE array, dimension (N)
The diagonal elements of the tridiagonal matrix T:
D(i) = A(i,i).
@param[out]
e DOUBLE array, dimension (N-1)
The off-diagonal elements of the tridiagonal matrix T:
E(i) = A(i,i+1) if UPLO = MagmaUpper, E(i) = A(i+1,i) if UPLO = MagmaLower.
@param[out]
V COMPLEX_16 array, dimension (BLKCNT, LDV, VBLKSIZ)
On exit it contains the blocks of householder reflectors
BLKCNT is the number of block and it is returned by the funtion MAGMA_BULGE_GET_BLKCNT.
@param[in]
ldv INTEGER
The leading dimension of V.
LDV > NB + VBLKSIZ + 1
@param[out]
TAU COMPLEX_16 dimension(BLKCNT, VBLKSIZ)
???
@param[in]
compT INTEGER
if COMPT = 0 T is not computed
if COMPT = 1 T is computed
@param[out]
T COMPLEX_16 dimension(LDT *)
if COMPT = 1 on exit contains the matrices T needed for Q2
if COMPT = 0 T is not referenced
@param[in]
ldt INTEGER
The leading dimension of T.
LDT > Vblksiz
@ingroup magma_zheev_2stage
********************************************************************/
extern "C" magma_int_t
magma_zhetrd_hb2st(
magma_uplo_t uplo, magma_int_t n, magma_int_t nb, magma_int_t Vblksiz,
magmaDoubleComplex *A, magma_int_t lda, double *d, double *e,
magmaDoubleComplex *V, magma_int_t ldv, magmaDoubleComplex *TAU,
magma_int_t compT, magmaDoubleComplex *T, magma_int_t ldt)
{
#ifdef ENABLE_TIMER
real_Double_t timeblg=0.0;
#endif
magma_int_t threads = magma_get_parallel_numthreads();
magma_int_t mklth = magma_get_lapack_numthreads();
magma_set_lapack_numthreads(1);
//const char* uplo_ = lapack_uplo_const( uplo );
magma_int_t INgrsiz=1;
magma_int_t blkcnt = magma_bulge_get_blkcnt(n, nb, Vblksiz);
magma_int_t nbtiles = magma_ceildiv(n, nb);
memset(T, 0, blkcnt*ldt*Vblksiz*sizeof(magmaDoubleComplex));
memset(TAU, 0, blkcnt*Vblksiz*sizeof(magmaDoubleComplex));
memset(V, 0, blkcnt*ldv*Vblksiz*sizeof(magmaDoubleComplex));
magma_int_t* prog;
magma_malloc_cpu((void**) &prog, (2*nbtiles+threads+10)*sizeof(magma_int_t));
memset(prog, 0, (2*nbtiles+threads+10)*sizeof(magma_int_t));
magma_zbulge_id_data* arg;
magma_malloc_cpu((void**) &arg, threads*sizeof(magma_zbulge_id_data));
pthread_t* thread_id;
magma_malloc_cpu((void**) &thread_id, threads*sizeof(pthread_t));
pthread_attr_t thread_attr;
magma_zbulge_data data_bulge(threads, n, nb, nbtiles, INgrsiz, Vblksiz, compT,
A, lda, V, ldv, TAU, T, ldt, prog);
// Set one thread per core
pthread_attr_init(&thread_attr);
pthread_attr_setscope(&thread_attr, PTHREAD_SCOPE_SYSTEM);
pthread_setconcurrency(threads);
//timing
#ifdef ENABLE_TIMER
timeblg = magma_wtime();
#endif
// Launch threads
for (magma_int_t thread = 1; thread < threads; thread++) {
arg[thread] = magma_zbulge_id_data(thread, &data_bulge);
pthread_create(&thread_id[thread], &thread_attr, magma_zhetrd_hb2st_parallel_section, &arg[thread]);
}
arg[0] = magma_zbulge_id_data(0, &data_bulge);
magma_zhetrd_hb2st_parallel_section(&arg[0]);
// Wait for completion
for (magma_int_t thread = 1; thread < threads; thread++) {
void *exitcodep;
pthread_join(thread_id[thread], &exitcodep);
}
// timing
#ifdef ENABLE_TIMER
timeblg = magma_wtime()-timeblg;
printf(" time BULGE+T = %f\n", timeblg);
#endif
magma_free_cpu(thread_id);
magma_free_cpu(arg);
magma_free_cpu(prog);
magma_set_lapack_numthreads(mklth);
/*================================================
* store resulting diag and lower diag d and e
* note that d and e are always real
*================================================*/
/* Make diagonal and superdiagonal elements real,
* storing them in d and e
*/
/* In complex case, the off diagonal element are
* not necessary real. we have to make off-diagonal
* elements real and copy them to e.
* When using HouseHolder elimination,
* the ZLARFG give us a real as output so, all the
* diagonal/off-diagonal element except the last one are already
* real and thus we need only to take the abs of the last
* one.
* */
#if defined(PRECISION_z) || defined(PRECISION_c)
if (uplo == MagmaLower) {
for (magma_int_t i=0; i < n-1; i++) {
d[i] = MAGMA_Z_REAL( A[i*lda ] );
e[i] = MAGMA_Z_REAL( A[i*lda+1] );
}
d[n-1] = MAGMA_Z_REAL(A[(n-1)*lda]);
} else { /* MagmaUpper not tested yet */
for (magma_int_t i=0; i < n-1; i++) {
d[i] = MAGMA_Z_REAL( A[i*lda+nb] );
e[i] = MAGMA_Z_REAL( A[i*lda+nb-1] );
}
d[n-1] = MAGMA_Z_REAL(A[(n-1)*lda+nb]);
} /* end MagmaUpper */
#else
if ( uplo == MagmaLower ) {
for (magma_int_t i=0; i < n-1; i++) {
d[i] = A[i*lda]; // diag
e[i] = A[i*lda+1]; // lower diag
}
d[n-1] = A[(n-1)*lda];
} else {
for (magma_int_t i=0; i < n-1; i++) {
d[i] = A[i*lda+nb]; // diag
e[i] = A[i*lda+nb-1]; // lower diag
}
d[n-1] = A[(n-1)*lda+nb];
}
#endif
return MAGMA_SUCCESS;
}
/**
Purpose
-------
CHEEVD_2STAGE computes all eigenvalues and, optionally, eigenvectors of a
complex Hermitian matrix A. It uses a two-stage algorithm for the tridiagonalization.
If eigenvectors are desired, it uses a divide and conquer algorithm.
The divide and conquer algorithm makes very mild assumptions about
floating point arithmetic. It will work on machines with a guard
digit in add/subtract, or on those binary machines without guard
digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
Cray-2. It could conceivably fail on hexadecimal or decimal machines
without guard digits, but we know of none.
Arguments
---------
@param[in]
jobz magma_vec_t
- = MagmaNoVec: Compute eigenvalues only;
- = MagmaVec: Compute eigenvalues and eigenvectors.
@param[in]
range magma_range_t
- = MagmaRangeAll: all eigenvalues will be found.
- = MagmaRangeV: all eigenvalues in the half-open interval (VL,VU]
will be found.
- = MagmaRangeI: the IL-th through IU-th eigenvalues will be found.
@param[in]
uplo magma_uplo_t
- = MagmaUpper: Upper triangle of A is stored;
- = MagmaLower: Lower triangle of A is stored.
@param[in]
n INTEGER
The order of the matrix A. N >= 0.
@param[in,out]
A COMPLEX array, dimension (LDA, N)
On entry, the Hermitian matrix A. If UPLO = MagmaUpper, the
leading N-by-N upper triangular part of A contains the
upper triangular part of the matrix A. If UPLO = MagmaLower,
the leading N-by-N lower triangular part of A contains
the lower triangular part of the matrix A.
On exit, if JOBZ = MagmaVec, then if INFO = 0, the first m columns
of A contains the required
orthonormal eigenvectors of the matrix A.
If JOBZ = MagmaNoVec, then on exit the lower triangle (if UPLO=MagmaLower)
or the upper triangle (if UPLO=MagmaUpper) of A, including the
diagonal, is destroyed.
@param[in]
lda INTEGER
The leading dimension of the array A. LDA >= max(1,N).
@param[in]
vl REAL
@param[in]
vu REAL
If RANGE=MagmaRangeV, the lower and upper bounds of the interval to
be searched for eigenvalues. VL < VU.
Not referenced if RANGE = MagmaRangeAll or MagmaRangeI.
@param[in]
il INTEGER
@param[in]
iu INTEGER
If RANGE=MagmaRangeI, the indices (in ascending order) of the
smallest and largest eigenvalues to be returned.
1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
Not referenced if RANGE = MagmaRangeAll or MagmaRangeV.
@param[out]
m INTEGER
The total number of eigenvalues found. 0 <= M <= N.
If RANGE = MagmaRangeAll, M = N, and if RANGE = MagmaRangeI, M = IU-IL+1.
@param[out]
w REAL array, dimension (N)
If INFO = 0, the required m eigenvalues in ascending order.
@param[out]
work (workspace) COMPLEX array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK[0] returns the optimal LWORK.
@param[in]
lwork INTEGER
The length of the array WORK.
If N <= 1, LWORK >= 1.
If JOBZ = MagmaNoVec and N > 1, LWORK >= LQ2 + N + N*NB.
If JOBZ = MagmaVec and N > 1, LWORK >= LQ2 + 2*N + N**2.
where LQ2 is the size needed to store the Q2 matrix
and is returned by magma_bulge_get_lq2.
\n
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal sizes of the WORK, RWORK and
IWORK arrays, returns these values as the first entries of
the WORK, RWORK and IWORK arrays, and no error message
related to LWORK or LRWORK or LIWORK is issued by XERBLA.
@param[out]
rwork (workspace) REAL array,
dimension (LRWORK)
On exit, if INFO = 0, RWORK[0] returns the optimal LRWORK.
@param[in]
lrwork INTEGER
The dimension of the array RWORK.
If N <= 1, LRWORK >= 1.
If JOBZ = MagmaNoVec and N > 1, LRWORK >= N.
If JOBZ = MagmaVec and N > 1, LRWORK >= 1 + 5*N + 2*N**2.
\n
If LRWORK = -1, then a workspace query is assumed; the
routine only calculates the optimal sizes of the WORK, RWORK
and IWORK arrays, returns these values as the first entries
of the WORK, RWORK and IWORK arrays, and no error message
related to LWORK or LRWORK or LIWORK is issued by XERBLA.
@param[out]
iwork (workspace) INTEGER array, dimension (MAX(1,LIWORK))
On exit, if INFO = 0, IWORK[0] returns the optimal LIWORK.
@param[in]
liwork INTEGER
The dimension of the array IWORK.
If N <= 1, LIWORK >= 1.
If JOBZ = MagmaNoVec and N > 1, LIWORK >= 1.
If JOBZ = MagmaVec and N > 1, LIWORK >= 3 + 5*N.
\n
If LIWORK = -1, then a workspace query is assumed; the
routine only calculates the optimal sizes of the WORK, RWORK
and IWORK arrays, returns these values as the first entries
of the WORK, RWORK and IWORK arrays, and no error message
related to LWORK or LRWORK or LIWORK is issued by XERBLA.
@param[out]
info INTEGER
- = 0: successful exit
- < 0: if INFO = -i, the i-th argument had an illegal value
- > 0: if INFO = i and JOBZ = MagmaNoVec, then the algorithm failed
to converge; i off-diagonal elements of an intermediate
tridiagonal form did not converge to zero;
if INFO = i and JOBZ = MagmaVec, then the algorithm failed
to compute an eigenvalue while working on the submatrix
lying in rows and columns INFO/(N+1) through
mod(INFO,N+1).
Further Details
---------------
Based on contributions by
Jeff Rutter, Computer Science Division, University of California
at Berkeley, USA
Modified description of INFO. Sven, 16 Feb 05.
@ingroup magma_cheev_driver
********************************************************************/
extern "C" magma_int_t
magma_cheevdx_2stage(
magma_vec_t jobz, magma_range_t range, magma_uplo_t uplo,
magma_int_t n,
magmaFloatComplex *A, magma_int_t lda,
float vl, float vu, magma_int_t il, magma_int_t iu,
magma_int_t *m, float *w,
magmaFloatComplex *work, magma_int_t lwork,
#ifdef COMPLEX
float *rwork, magma_int_t lrwork,
#endif
magma_int_t *iwork, magma_int_t liwork,
magma_int_t *info)
{
#define A( i_,j_) (A + (i_) + (j_)*lda)
#define A2(i_,j_) (A2 + (i_) + (j_)*lda2)
const char* uplo_ = lapack_uplo_const( uplo );
const char* jobz_ = lapack_vec_const( jobz );
magmaFloatComplex c_one = MAGMA_C_ONE;
magma_int_t ione = 1;
magma_int_t izero = 0;
float d_one = 1.;
float d__1;
float eps;
float anrm;
magma_int_t imax;
float rmin, rmax;
float sigma;
//magma_int_t iinfo;
magma_int_t lwmin, lrwmin, liwmin;
magma_int_t lower;
magma_int_t wantz;
magma_int_t iscale;
float safmin;
float bignum;
float smlnum;
magma_int_t lquery;
magma_int_t alleig, valeig, indeig;
magma_int_t len;
float* dwork;
/* determine the number of threads */
magma_int_t parallel_threads = magma_get_parallel_numthreads();
wantz = (jobz == MagmaVec);
lower = (uplo == MagmaLower);
alleig = (range == MagmaRangeAll);
valeig = (range == MagmaRangeV);
indeig = (range == MagmaRangeI);
lquery = (lwork == -1 || lrwork == -1 || liwork == -1);
*info = 0;
if (! (wantz || (jobz == MagmaNoVec))) {
*info = -1;
} else if (! (alleig || valeig || indeig)) {
*info = -2;
} else if (! (lower || (uplo == MagmaUpper))) {
*info = -3;
} else if (n < 0) {
*info = -4;
} else if (lda < max(1,n)) {
*info = -6;
} else {
if (valeig) {
if (n > 0 && vu <= vl) {
*info = -8;
}
} else if (indeig) {
if (il < 1 || il > max(1,n)) {
*info = -9;
} else if (iu < min(n,il) || iu > n) {
*info = -10;
}
}
}
magma_int_t nb = magma_get_cbulge_nb(n,parallel_threads);
magma_int_t Vblksiz = magma_cbulge_get_Vblksiz(n, nb, parallel_threads);
magma_int_t ldt = Vblksiz;
magma_int_t ldv = nb + Vblksiz;
magma_int_t blkcnt = magma_bulge_get_blkcnt(n, nb, Vblksiz);
magma_int_t lq2 = magma_cbulge_get_lq2(n, parallel_threads);
if (wantz) {
lwmin = lq2 + 2*n + n*n;
lrwmin = 1 + 5*n + 2*n*n;
liwmin = 5*n + 3;
} else {
lwmin = lq2 + n + n*nb;
lrwmin = n;
liwmin = 1;
}
// multiply by 1+eps (in Double!) to ensure length gets rounded up,
// if it cannot be exactly represented in floating point.
real_Double_t one_eps = 1. + lapackf77_slamch("Epsilon");
work[0] = MAGMA_C_MAKE( lwmin * one_eps, 0.); // round up
rwork[0] = lrwmin * one_eps;
iwork[0] = liwmin;
if ((lwork < lwmin) && !lquery) {
*info = -14;
} else if ((lrwork < lrwmin) && ! lquery) {
*info = -16;
} else if ((liwork < liwmin) && ! lquery) {
*info = -18;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery) {
return *info;
}
/* Quick return if possible */
if (n == 0) {
return *info;
}
if (n == 1) {
w[0] = MAGMA_C_REAL(A[0]);
if (wantz) {
A[0] = MAGMA_C_ONE;
}
return *info;
}
timer_printf("using %d parallel_threads\n", (int) parallel_threads);
/* Check if matrix is very small then just call LAPACK on CPU, no need for GPU */
magma_int_t ntiles = n/nb;
if ( ( ntiles < 2 ) || ( n <= 128 ) ) {
#ifdef ENABLE_DEBUG
printf("--------------------------------------------------------------\n");
printf(" warning matrix too small N=%d NB=%d, calling lapack on CPU \n", (int) n, (int) nb);
printf("--------------------------------------------------------------\n");
#endif
lapackf77_cheevd(jobz_, uplo_, &n,
A, &lda, w,
work, &lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, &lrwork,
#endif
iwork, &liwork,
info);
*m = n;
return *info;
}
/* Get machine constants. */
safmin = lapackf77_slamch("Safe minimum");
eps = lapackf77_slamch("Precision");
smlnum = safmin / eps;
bignum = 1. / smlnum;
rmin = magma_ssqrt(smlnum);
rmax = magma_ssqrt(bignum);
/* Scale matrix to allowable range, if necessary. */
anrm = lapackf77_clanhe("M", uplo_, &n, A, &lda, rwork);
iscale = 0;
if (anrm > 0. && anrm < rmin) {
iscale = 1;
sigma = rmin / anrm;
} else if (anrm > rmax) {
iscale = 1;
sigma = rmax / anrm;
}
if (iscale == 1) {
lapackf77_clascl(uplo_, &izero, &izero, &d_one, &sigma, &n, &n, A,
&lda, info);
}
magma_int_t indT2 = 0;
magma_int_t indTAU2 = indT2 + blkcnt*ldt*Vblksiz;
magma_int_t indV2 = indTAU2+ blkcnt*Vblksiz;
magma_int_t indtau1 = indV2 + blkcnt*ldv*Vblksiz;
magma_int_t indwrk = indtau1+ n;
//magma_int_t indwk2 = indwrk + n*n;
magma_int_t llwork = lwork - indwrk;
//magma_int_t llwrk2 = lwork - indwk2;
magma_int_t inde = 0;
magma_int_t indrwk = inde + n;
magma_int_t llrwk = lrwork - indrwk;
magma_timer_t time=0, time_total=0;
timer_start( time_total );
timer_start( time );
magmaFloatComplex *dT1;
if (MAGMA_SUCCESS != magma_cmalloc( &dT1, n*nb)) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
magma_chetrd_he2hb(uplo, n, nb, A, lda, &work[indtau1], &work[indwrk], llwork, dT1, info);
timer_stop( time );
timer_printf( " time chetrd_he2hb = %6.2f\n", time );
timer_start( time );
/* copy the input matrix into WORK(INDWRK) with band storage */
/* PAY ATTENTION THAT work[indwrk] should be able to be of size lda2*n which it should be checked in any future modification of lwork.*/
magma_int_t lda2 = 2*nb; //nb+1+(nb-1);
magmaFloatComplex* A2 = &work[indwrk];
memset(A2, 0, n*lda2*sizeof(magmaFloatComplex));
for (magma_int_t j = 0; j < n-nb; j++) {
len = nb+1;
blasf77_ccopy( &len, A(j,j), &ione, A2(0,j), &ione );
memset(A(j,j), 0, (nb+1)*sizeof(magmaFloatComplex));
*A(nb+j,j) = c_one;
}
for (magma_int_t j = 0; j < nb; j++) {
len = nb-j;
blasf77_ccopy( &len, A(j+n-nb,j+n-nb), &ione, A2(0,j+n-nb), &ione );
memset(A(j+n-nb,j+n-nb), 0, (nb-j)*sizeof(magmaFloatComplex));
}
timer_stop( time );
timer_printf( " time chetrd_convert = %6.2f\n", time );
timer_start( time );
magma_chetrd_hb2st(uplo, n, nb, Vblksiz, A2, lda2, w, &rwork[inde], &work[indV2], ldv, &work[indTAU2], wantz, &work[indT2], ldt);
timer_stop( time );
timer_stop( time_total );
timer_printf( " time chetrd_hb2st = %6.2f\n", time );
timer_printf( " time chetrd = %6.2f\n", time_total );
/* For eigenvalues only, call SSTERF. For eigenvectors, first call
CSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
tridiagonal matrix, then call CUNMTR to multiply it to the Householder
transformations represented as Householder vectors in A. */
if (! wantz) {
timer_start( time );
lapackf77_ssterf(&n, w, &rwork[inde], info);
magma_smove_eig(range, n, w, &il, &iu, vl, vu, m);
timer_stop( time );
timer_printf( " time dstedc = %6.2f\n", time );
}
else {
timer_start( time_total );
timer_start( time );
if (MAGMA_SUCCESS != magma_smalloc( &dwork, 3*n*(n/2 + 1) )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
magma_cstedx(range, n, vl, vu, il, iu, w, &rwork[inde],
&work[indwrk], n, &rwork[indrwk],
llrwk, iwork, liwork, dwork, info);
magma_free( dwork );
timer_stop( time );
timer_printf( " time cstedx = %6.2f\n", time );
timer_start( time );
magmaFloatComplex *dZ;
magma_int_t lddz = n;
magmaFloatComplex *da;
magma_int_t ldda = n;
magma_smove_eig(range, n, w, &il, &iu, vl, vu, m);
if (MAGMA_SUCCESS != magma_cmalloc( &dZ, *m*lddz)) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
if (MAGMA_SUCCESS != magma_cmalloc( &da, n*ldda )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
magma_cbulge_back(uplo, n, nb, *m, Vblksiz, &work[indwrk + n * (il-1)], n, dZ, lddz,
&work[indV2], ldv, &work[indTAU2], &work[indT2], ldt, info);
timer_stop( time );
timer_printf( " time cbulge_back = %6.2f\n", time );
timer_start( time );
magma_csetmatrix( n, n, A, lda, da, ldda );
magma_cunmqr_gpu_2stages(MagmaLeft, MagmaNoTrans, n-nb, *m, n-nb, da+nb, ldda,
dZ+nb, n, dT1, nb, info);
magma_cgetmatrix( n, *m, dZ, lddz, A, lda );
magma_free(dT1);
magma_free(dZ);
magma_free(da);
timer_stop( time );
timer_stop( time_total );
timer_printf( " time cunmqr + copy = %6.2f\n", time );
timer_printf( " time eigenvectors backtransf. = %6.2f\n", time_total );
}
/* If matrix was scaled, then rescale eigenvalues appropriately. */
if (iscale == 1) {
if (*info == 0) {
imax = n;
} else {
imax = *info - 1;
}
d__1 = 1. / sigma;
blasf77_sscal(&imax, &d__1, w, &ione);
}
work[0] = MAGMA_C_MAKE( lwmin * one_eps, 0.); // round up
rwork[0] = lrwmin * one_eps;
iwork[0] = liwmin;
return *info;
} /* magma_cheevdx_2stage */
/**
Purpose
-------
ZHEEVD_2STAGE computes all eigenvalues and, optionally, eigenvectors of a
complex Hermitian matrix A. It uses a two-stage algorithm for the tridiagonalization.
If eigenvectors are desired, it uses a divide and conquer algorithm.
The divide and conquer algorithm makes very mild assumptions about
floating point arithmetic. It will work on machines with a guard
digit in add/subtract, or on those binary machines without guard
digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
Cray-2. It could conceivably fail on hexadecimal or decimal machines
without guard digits, but we know of none.
Arguments
---------
@param[in]
nrgpu INTEGER
Number of GPUs to use.
@param[in]
jobz magma_vec_t
- = MagmaNoVec: Compute eigenvalues only;
- = MagmaVec: Compute eigenvalues and eigenvectors.
@param[in]
range magma_range_t
- = MagmaRangeAll: all eigenvalues will be found.
- = MagmaRangeV: all eigenvalues in the half-open interval (VL,VU]
will be found.
- = MagmaRangeI: the IL-th through IU-th eigenvalues will be found.
@param[in]
uplo magma_uplo_t
- = MagmaUpper: Upper triangle of A is stored;
- = MagmaLower: Lower triangle of A is stored.
@param[in]
n INTEGER
The order of the matrix A. N >= 0.
@param[in,out]
A COMPLEX_16 array, dimension (LDA, N)
On entry, the Hermitian matrix A. If UPLO = MagmaUpper, the
leading N-by-N upper triangular part of A contains the
upper triangular part of the matrix A. If UPLO = MagmaLower,
the leading N-by-N lower triangular part of A contains
the lower triangular part of the matrix A.
On exit, if JOBZ = MagmaVec, then if INFO = 0, the first m columns
of A contains the required
orthonormal eigenvectors of the matrix A.
If JOBZ = MagmaNoVec, then on exit the lower triangle (if UPLO=MagmaLower)
or the upper triangle (if UPLO=MagmaUpper) of A, including the
diagonal, is destroyed.
@param[in]
lda INTEGER
The leading dimension of the array A. LDA >= max(1,N).
@param[in]
vl DOUBLE PRECISION
@param[in]
vu DOUBLE PRECISION
If RANGE=MagmaRangeV, the lower and upper bounds of the interval to
be searched for eigenvalues. VL < VU.
Not referenced if RANGE = MagmaRangeAll or MagmaRangeI.
@param[in]
il INTEGER
@param[in]
iu INTEGER
If RANGE=MagmaRangeI, the indices (in ascending order) of the
smallest and largest eigenvalues to be returned.
1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
Not referenced if RANGE = MagmaRangeAll or MagmaRangeV.
@param[out]
m INTEGER
The total number of eigenvalues found. 0 <= M <= N.
If RANGE = MagmaRangeAll, M = N, and if RANGE = MagmaRangeI, M = IU-IL+1.
@param[out]
w DOUBLE PRECISION array, dimension (N)
If INFO = 0, the required m eigenvalues in ascending order.
@param[out]
work (workspace) COMPLEX_16 array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK[0] returns the optimal LWORK.
@param[in]
lwork INTEGER
The length of the array WORK.
If N <= 1, LWORK >= 1.
If JOBZ = MagmaNoVec and N > 1, LWORK >= LQ2 + N + N*NB.
If JOBZ = MagmaVec and N > 1, LWORK >= LQ2 + 2*N + N**2.
where LQ2 is the size needed to store the Q2 matrix
and is returned by magma_bulge_get_lq2.
\n
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal sizes of the WORK, RWORK and
IWORK arrays, returns these values as the first entries of
the WORK, RWORK and IWORK arrays, and no error message
related to LWORK or LRWORK or LIWORK is issued by XERBLA.
@param[out]
rwork (workspace) DOUBLE PRECISION array,
dimension (LRWORK)
On exit, if INFO = 0, RWORK[0] returns the optimal LRWORK.
@param[in]
lrwork INTEGER
The dimension of the array RWORK.
If N <= 1, LRWORK >= 1.
If JOBZ = MagmaNoVec and N > 1, LRWORK >= N.
If JOBZ = MagmaVec and N > 1, LRWORK >= 1 + 5*N + 2*N**2.
\n
If LRWORK = -1, then a workspace query is assumed; the
routine only calculates the optimal sizes of the WORK, RWORK
and IWORK arrays, returns these values as the first entries
of the WORK, RWORK and IWORK arrays, and no error message
related to LWORK or LRWORK or LIWORK is issued by XERBLA.
@param[out]
iwork (workspace) INTEGER array, dimension (MAX(1,LIWORK))
On exit, if INFO = 0, IWORK[0] returns the optimal LIWORK.
@param[in]
liwork INTEGER
The dimension of the array IWORK.
If N <= 1, LIWORK >= 1.
If JOBZ = MagmaNoVec and N > 1, LIWORK >= 1.
If JOBZ = MagmaVec and N > 1, LIWORK >= 3 + 5*N.
\n
If LIWORK = -1, then a workspace query is assumed; the
routine only calculates the optimal sizes of the WORK, RWORK
and IWORK arrays, returns these values as the first entries
of the WORK, RWORK and IWORK arrays, and no error message
related to LWORK or LRWORK or LIWORK is issued by XERBLA.
@param[out]
info INTEGER
- = 0: successful exit
- < 0: if INFO = -i, the i-th argument had an illegal value
- > 0: if INFO = i and JOBZ = MagmaNoVec, then the algorithm failed
to converge; i off-diagonal elements of an intermediate
tridiagonal form did not converge to zero;
if INFO = i and JOBZ = MagmaVec, then the algorithm failed
to compute an eigenvalue while working on the submatrix
lying in rows and columns INFO/(N+1) through
mod(INFO,N+1).
Further Details
---------------
Based on contributions by
Jeff Rutter, Computer Science Division, University of California
at Berkeley, USA
Modified description of INFO. Sven, 16 Feb 05.
@ingroup magma_zheev_driver
********************************************************************/
extern "C" magma_int_t
magma_zheevdx_2stage_m(magma_int_t nrgpu, magma_vec_t jobz, magma_range_t range, magma_uplo_t uplo,
magma_int_t n,
magmaDoubleComplex *A, magma_int_t lda,
double vl, double vu, magma_int_t il, magma_int_t iu,
magma_int_t *m, double *w,
magmaDoubleComplex *work, magma_int_t lwork,
double *rwork, magma_int_t lrwork,
magma_int_t *iwork, magma_int_t liwork,
magma_int_t *info)
{
#define A( i_,j_) (A + (i_) + (j_)*lda)
#define A2(i_,j_) (A2 + (i_) + (j_)*lda2)
const char* uplo_ = lapack_uplo_const( uplo );
const char* jobz_ = lapack_vec_const( jobz );
magmaDoubleComplex c_one = MAGMA_Z_ONE;
double d_one = 1.;
magma_int_t ione = 1;
magma_int_t izero = 0;
double d__1;
double eps;
double anrm;
magma_int_t imax;
double rmin, rmax;
double sigma;
//magma_int_t iinfo;
magma_int_t lwmin, lrwmin, liwmin;
magma_int_t lower;
magma_int_t wantz;
magma_int_t iscale;
double safmin;
double bignum;
double smlnum;
magma_int_t lquery;
magma_int_t alleig, valeig, indeig;
magma_int_t len;
/* determine the number of threads */
magma_int_t parallel_threads = magma_get_parallel_numthreads();
wantz = (jobz == MagmaVec);
lower = (uplo == MagmaLower);
alleig = (range == MagmaRangeAll);
valeig = (range == MagmaRangeV);
indeig = (range == MagmaRangeI);
lquery = (lwork == -1 || lrwork == -1 || liwork == -1);
*info = 0;
if (! (wantz || (jobz == MagmaNoVec))) {
*info = -1;
} else if (! (alleig || valeig || indeig)) {
*info = -2;
} else if (! (lower || (uplo == MagmaUpper))) {
*info = -3;
} else if (n < 0) {
*info = -4;
} else if (lda < max(1,n)) {
*info = -6;
} else {
if (valeig) {
if (n > 0 && vu <= vl) {
*info = -8;
}
} else if (indeig) {
if (il < 1 || il > max(1,n)) {
*info = -9;
} else if (iu < min(n,il) || iu > n) {
*info = -10;
}
}
}
magma_int_t nb = magma_get_zbulge_nb(n, parallel_threads);
magma_int_t Vblksiz = magma_zbulge_get_Vblksiz(n, nb, parallel_threads);
magma_int_t ldt = Vblksiz;
magma_int_t ldv = nb + Vblksiz;
magma_int_t blkcnt = magma_bulge_get_blkcnt(n, nb, Vblksiz);
magma_int_t lq2 = magma_zbulge_get_lq2(n, parallel_threads);
if (wantz) {
lwmin = lq2 + 2*n + n*n;
lrwmin = 1 + 5*n + 2*n*n;
liwmin = 5*n + 3;
} else {
lwmin = lq2 + n + n*nb;
lrwmin = n;
liwmin = 1;
}
// multiply by 1+eps (in Double!) to ensure length gets rounded up,
// if it cannot be exactly represented in floating point.
real_Double_t one_eps = 1. + lapackf77_dlamch("Epsilon");
work[0] = MAGMA_Z_MAKE( lwmin * one_eps, 0.); // round up
rwork[0] = lrwmin * one_eps;
iwork[0] = liwmin;
if ((lwork < lwmin) && !lquery) {
*info = -14;
} else if ((lrwork < lrwmin) && ! lquery) {
*info = -16;
} else if ((liwork < liwmin) && ! lquery) {
*info = -18;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery) {
return *info;
}
/* Quick return if possible */
if (n == 0) {
return *info;
}
if (n == 1) {
w[0] = MAGMA_Z_REAL(A[0]);
if (wantz) {
A[0] = MAGMA_Z_ONE;
}
return *info;
}
magma_device_t orig_dev;
magma_getdevice( &orig_dev );
timer_printf("using %d parallel_threads\n", (int) parallel_threads);
/* Check if matrix is very small then just call LAPACK on CPU, no need for GPU */
magma_int_t ntiles = n/nb;
if ( ( ntiles < 2 ) || ( n <= 128 ) ) {
#ifdef ENABLE_DEBUG
printf("--------------------------------------------------------------\n");
printf(" warning matrix too small N=%d NB=%d, calling lapack on CPU \n", (int) n, (int) nb);
printf("--------------------------------------------------------------\n");
#endif
lapackf77_zheevd(jobz_, uplo_, &n,
A, &lda, w,
work, &lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, &lrwork,
#endif
iwork, &liwork,
info);
*m = n;
return *info;
}
/* Get machine constants. */
safmin = lapackf77_dlamch("Safe minimum");
eps = lapackf77_dlamch("Precision");
smlnum = safmin / eps;
bignum = 1. / smlnum;
rmin = magma_dsqrt(smlnum);
rmax = magma_dsqrt(bignum);
/* Scale matrix to allowable range, if necessary. */
anrm = lapackf77_zlanhe("M", uplo_, &n, A, &lda, rwork);
iscale = 0;
if (anrm > 0. && anrm < rmin) {
iscale = 1;
sigma = rmin / anrm;
} else if (anrm > rmax) {
iscale = 1;
sigma = rmax / anrm;
}
if (iscale == 1) {
lapackf77_zlascl(uplo_, &izero, &izero, &d_one, &sigma, &n, &n, A,
&lda, info);
}
magma_int_t indT2 = 0;
magma_int_t indTAU2 = indT2 + blkcnt*ldt*Vblksiz;
magma_int_t indV2 = indTAU2+ blkcnt*Vblksiz;
magma_int_t indtau1 = indV2 + blkcnt*ldv*Vblksiz;
magma_int_t indwrk = indtau1+ n;
magma_int_t indwk2 = indwrk + n*n;
magma_int_t llwork = lwork - indwrk;
magma_int_t llwrk2 = lwork - indwk2;
magma_int_t inde = 0;
magma_int_t indrwk = inde + n;
magma_int_t llrwk = lrwork - indrwk;
magma_timer_t time=0, time_total=0, time_alloc=0, time_dist=0, time_band=0;
timer_start( time_total );
#ifdef HE2HB_SINGLEGPU
magmaDoubleComplex *dT1;
if (MAGMA_SUCCESS != magma_zmalloc( &dT1, n*nb)) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
timer_start( time_band );
magma_zhetrd_he2hb(uplo, n, nb, A, lda, &work[indtau1], &work[indwrk], llwork, dT1, info);
timer_stop( time_band );
timer_printf( " 1 GPU seq code time zhetrd_he2hb only = %7.4f\n", time_band );
magma_free(dT1);
#else
magma_int_t nstream = max(3,nrgpu+2);
magma_queue_t streams[MagmaMaxGPUs][20];
magmaDoubleComplex *da[MagmaMaxGPUs], *dT1[MagmaMaxGPUs];
magma_int_t ldda = ((n+31)/32)*32;
magma_int_t ver = 0;
magma_int_t distblk = max(256, 4*nb);
#ifdef ENABLE_DEBUG
printf("voici ngpu %d distblk %d NB %d nstream %d version %d \n ", nrgpu, distblk, nb, nstream, ver);
#endif
timer_start( time_alloc );
for( magma_int_t dev = 0; dev < nrgpu; ++dev ) {
magma_int_t mlocal = ((n / distblk) / nrgpu + 1) * distblk;
magma_setdevice( dev );
// TODO check malloc
magma_zmalloc(&da[dev], ldda*mlocal );
magma_zmalloc(&dT1[dev], (n*nb) );
for( int i = 0; i < nstream; ++i ) {
magma_queue_create( &streams[dev][i] );
}
}
timer_stop( time_alloc );
timer_start( time_dist );
magma_zsetmatrix_1D_col_bcyclic( n, n, A, lda, da, ldda, nrgpu, distblk );
magma_setdevice(0);
timer_stop( time_dist );
timer_start( time_band );
if (ver == 30) {
magma_zhetrd_he2hb_mgpu_spec(uplo, n, nb, A, lda, &work[indtau1], &work[indwrk], llwork, da, ldda, dT1, nb, nrgpu, distblk, streams, nstream, info);
} else {
magma_zhetrd_he2hb_mgpu(uplo, n, nb, A, lda, &work[indtau1], &work[indwrk], llwork, da, ldda, dT1, nb, nrgpu, distblk, streams, nstream, info);
}
timer_stop( time_band );
timer_printf(" time alloc %7.4f, ditribution %7.4f, zhetrd_he2hb only = %7.4f\n", time_alloc, time_dist, time_band );
for( magma_int_t dev = 0; dev < nrgpu; ++dev ) {
magma_setdevice( dev );
magma_free( da[dev] );
magma_free( dT1[dev] );
for( int i = 0; i < nstream; ++i ) {
magma_queue_destroy( streams[dev][i] );
}
}
#endif // not HE2HB_SINGLEGPU
timer_stop( time_total );
timer_printf( " time zhetrd_he2hb_mgpu = %6.2f\n", time_total );
timer_start( time_total );
timer_start( time );
/* copy the input matrix into WORK(INDWRK) with band storage */
/* PAY ATTENTION THAT work[indwrk] should be able to be of size lda2*n which it should be checked in any future modification of lwork.*/
magma_int_t lda2 = 2*nb; //nb+1+(nb-1);
magmaDoubleComplex* A2 = &work[indwrk];
memset(A2, 0, n*lda2*sizeof(magmaDoubleComplex));
for (magma_int_t j = 0; j < n-nb; j++) {
len = nb+1;
blasf77_zcopy( &len, A(j,j), &ione, A2(0,j), &ione );
memset(A(j,j), 0, (nb+1)*sizeof(magmaDoubleComplex));
*A(nb+j,j) = c_one;
}
for (magma_int_t j = 0; j < nb; j++) {
len = nb-j;
blasf77_zcopy( &len, A(j+n-nb,j+n-nb), &ione, A2(0,j+n-nb), &ione );
memset(A(j+n-nb,j+n-nb), 0, (nb-j)*sizeof(magmaDoubleComplex));
}
timer_stop( time );
timer_printf( " time zhetrd_convert = %6.2f\n", time );
timer_start( time );
magma_zhetrd_hb2st(uplo, n, nb, Vblksiz, A2, lda2, w, &rwork[inde], &work[indV2], ldv, &work[indTAU2], wantz, &work[indT2], ldt);
timer_stop( time );
timer_stop( time_total );
timer_printf( " time zhetrd_hb2st = %6.2f\n", time );
timer_printf( " time zhetrd = %6.2f\n", time_total );
/* For eigenvalues only, call DSTERF. For eigenvectors, first call
ZSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
tridiagonal matrix, then call ZUNMTR to multiply it to the Householder
transformations represented as Householder vectors in A. */
if (! wantz) {
timer_start( time );
lapackf77_dsterf(&n, w, &rwork[inde], info);
magma_dmove_eig(range, n, w, &il, &iu, vl, vu, m);
timer_stop( time );
timer_printf( " time dstedc = %6.2f\n", time );
}
else {
timer_start( time_total );
timer_start( time );
magma_zstedx_m(nrgpu, range, n, vl, vu, il, iu, w, &rwork[inde],
&work[indwrk], n, &rwork[indrwk],
llrwk, iwork, liwork, info);
timer_stop( time );
timer_printf( " time zstedx_m = %6.2f\n", time );
timer_start( time );
magma_dmove_eig(range, n, w, &il, &iu, vl, vu, m);
/*
magmaDoubleComplex *dZ;
magma_int_t lddz = n;
if (MAGMA_SUCCESS != magma_zmalloc( &dZ, *m*lddz)) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
magma_zbulge_back(uplo, n, nb, *m, Vblksiz, &work[indwrk + n * (il-1)], n, dZ, lddz,
&work[indV2], ldv, &work[indTAU2], &work[indT2], ldt, info);
magma_zgetmatrix( n, *m, dZ, lddz, &work[indwrk], n);
magma_free(dZ);
*/
magma_zbulge_back_m(nrgpu, uplo, n, nb, *m, Vblksiz, &work[indwrk + n * (il-1)], n,
&work[indV2], ldv, &work[indTAU2], &work[indT2], ldt, info);
timer_stop( time );
timer_printf( " time zbulge_back_m = %6.2f\n", time );
timer_start( time );
magma_zunmqr_m(nrgpu, MagmaLeft, MagmaNoTrans, n-nb, *m, n-nb, A+nb, lda, &work[indtau1],
&work[indwrk + n * (il-1) + nb], n, &work[indwk2], llwrk2, info);
lapackf77_zlacpy("A", &n, m, &work[indwrk + n * (il-1)], &n, A, &lda);
timer_stop( time );
timer_stop( time_total );
timer_printf( " time zunmqr_m + copy = %6.2f\n", time );
timer_printf( " time eigenvectors backtransf. = %6.2f\n", time_total );
}
/* If matrix was scaled, then rescale eigenvalues appropriately. */
if (iscale == 1) {
if (*info == 0) {
imax = n;
} else {
imax = *info - 1;
}
d__1 = 1. / sigma;
blasf77_dscal(&imax, &d__1, w, &ione);
}
work[0] = MAGMA_Z_MAKE( lwmin * one_eps, 0.); // round up
rwork[0] = lrwmin * one_eps;
iwork[0] = liwmin;
magma_setdevice( orig_dev );
return *info;
} /* magma_zheevdx_2stage_m */
