magma_int_t magma_ztrevc3_mt(
magma_side_t side, magma_vec_t howmany,
magma_int_t *select, // logical in Fortran
magma_int_t n,
magmaDoubleComplex *T, magma_int_t ldt,
magmaDoubleComplex *VL, magma_int_t ldvl,
magmaDoubleComplex *VR, magma_int_t ldvr,
magma_int_t mm, magma_int_t *mout,
magmaDoubleComplex *work, magma_int_t lwork,
#ifdef COMPLEX
double *rwork,
#endif
magma_int_t *info )
{
#define T(i,j) ( T + (i) + (j)*ldt )
#define VL(i,j) (VL + (i) + (j)*ldvl)
#define VR(i,j) (VR + (i) + (j)*ldvr)
#define work(i,j) (work + (i) + (j)*n)
// .. Parameters ..
const magmaDoubleComplex c_zero = MAGMA_Z_ZERO;
const magmaDoubleComplex c_one = MAGMA_Z_ONE;
const magma_int_t nbmin = 16, nbmax = 128;
const magma_int_t ione = 1;
// .. Local Scalars ..
magma_int_t allv, bothv, leftv, over, rightv, somev;
magma_int_t i, ii, is, j, k, ki, iv, n2, nb, nb2, version;
double ovfl, remax, unfl; //smlnum, smin, ulp
// Decode and test the input parameters
bothv = (side == MagmaBothSides);
rightv = (side == MagmaRight) || bothv;
leftv = (side == MagmaLeft ) || bothv;
allv = (howmany == MagmaAllVec);
over = (howmany == MagmaBacktransVec);
somev = (howmany == MagmaSomeVec);
// Set mout to the number of columns required to store the selected
// eigenvectors.
if ( somev ) {
*mout = 0;
for( j=0; j < n; ++j ) {
if ( select[j] ) {
*mout += 1;
}
}
}
else {
*mout = n;
}
*info = 0;
if ( ! rightv && ! leftv )
*info = -1;
else if ( ! allv && ! over && ! somev )
*info = -2;
else if ( n < 0 )
*info = -4;
else if ( ldt < max( 1, n ) )
*info = -6;
else if ( ldvl < 1 || ( leftv && ldvl < n ) )
*info = -8;
else if ( ldvr < 1 || ( rightv && ldvr < n ) )
*info = -10;
else if ( mm < *mout )
*info = -11;
else if ( lwork < max( 1, 2*n ) )
*info = -14;
if ( *info != 0 ) {
magma_xerbla( __func__, -(*info) );
return *info;
}
// Quick return if possible.
if ( n == 0 ) {
return *info;
}
// Use blocked version (2) if sufficient workspace.
// Requires 1 vector to save diagonal elements, and 2*nb vectors for x and Q*x.
// (Compared to dtrevc3, rwork stores 1-norms.)
// Zero-out the workspace to avoid potential NaN propagation.
nb = 2;
if ( lwork >= n + 2*n*nbmin ) {
version = 2;
nb = (lwork - n) / (2*n);
nb = min( nb, nbmax );
nb2 = 1 + 2*nb;
lapackf77_zlaset( "F", &n, &nb2, &c_zero, &c_zero, work, &n );
}
else {
version = 1;
}
// Set the constants to control overflow.
unfl = lapackf77_dlamch( "Safe minimum" );
ovfl = 1. / unfl;
lapackf77_dlabad( &unfl, &ovfl );
//ulp = lapackf77_dlamch( "Precision" );
//smlnum = unfl*( n / ulp );
// Store the diagonal elements of T in working array work.
for( i=0; i < n; ++i ) {
*work(i,0) = *T(i,i);
}
// Compute 1-norm of each column of strictly upper triangular
// part of T to control overflow in triangular solver.
rwork[0] = 0.;
for( j=1; j < n; ++j ) {
rwork[j] = magma_cblas_dzasum( j, T(0,j), ione );
}
// launch threads -- each single-threaded MKL
magma_int_t nthread = magma_get_parallel_numthreads();
magma_int_t lapack_nthread = magma_get_lapack_numthreads();
magma_set_lapack_numthreads( 1 );
magma_thread_queue queue;
queue.launch( nthread );
//printf( "nthread %d, %d\n", nthread, lapack_nthread );
// gemm_nb = N/thread, rounded up to multiple of 16,
// but avoid multiples of page size, e.g., 512*8 bytes = 4096.
magma_int_t gemm_nb = magma_int_t( ceil( ceil( ((double)n) / nthread ) / 16. ) * 16. );
if ( gemm_nb % 512 == 0 ) {
gemm_nb += 32;
}
magma_timer_t time_total=0, time_trsv=0, time_gemm=0, time_gemv=0, time_trsv_sum=0, time_gemm_sum=0, time_gemv_sum=0;
timer_start( time_total );
if ( rightv ) {
// ============================================================
// Compute right eigenvectors.
// iv is index of column in current block.
// Non-blocked version always uses iv=1;
// blocked version starts with iv=nb, goes down to 1.
// (Note the "0-th" column is used to store the original diagonal.)
iv = 1;
if ( version == 2 ) {
iv = nb;
}
timer_start( time_trsv );
is = *mout - 1;
for( ki=n-1; ki >= 0; --ki ) {
if ( somev ) {
if ( ! select[ki] ) {
continue;
}
}
//smin = max( ulp*MAGMA_Z_ABS1( *T(ki,ki) ), smlnum );
// --------------------------------------------------------
// Complex right eigenvector
*work(ki,iv) = c_one;
// Form right-hand side.
for( k=0; k < ki; ++k ) {
*work(k,iv) = -(*T(k,ki));
}
// Solve upper triangular system:
// [ T(1:ki-1,1:ki-1) - T(ki,ki) ]*X = scale*work.
if ( ki > 0 ) {
queue.push_task( new magma_zlatrsd_task(
MagmaUpper, MagmaNoTrans, MagmaNonUnit, MagmaTrue,
ki, T, ldt, *T(ki,ki),
work(0,iv), work(ki,iv), rwork ));
}
// Copy the vector x or Q*x to VR and normalize.
if ( ! over ) {
// ------------------------------
// no back-transform: copy x to VR and normalize
queue.sync();
n2 = ki+1;
blasf77_zcopy( &n2, work(0,iv), &ione, VR(0,is), &ione );
ii = blasf77_izamax( &n2, VR(0,is), &ione ) - 1;
remax = 1. / MAGMA_Z_ABS1( *VR(ii,is) );
blasf77_zdscal( &n2, &remax, VR(0,is), &ione );
for( k=ki+1; k < n; ++k ) {
*VR(k,is) = c_zero;
}
}
else if ( version == 1 ) {
// ------------------------------
// version 1: back-transform each vector with GEMV, Q*x.
queue.sync();
time_trsv_sum += timer_stop( time_trsv );
timer_start( time_gemv );
if ( ki > 0 ) {
blasf77_zgemv( "n", &n, &ki, &c_one,
VR, &ldvr,
work(0, iv), &ione,
work(ki,iv), VR(0,ki), &ione );
}
time_gemv_sum += timer_stop( time_gemv );
ii = blasf77_izamax( &n, VR(0,ki), &ione ) - 1;
remax = 1. / MAGMA_Z_ABS1( *VR(ii,ki) );
blasf77_zdscal( &n, &remax, VR(0,ki), &ione );
timer_start( time_trsv );
}
else if ( version == 2 ) {
// ------------------------------
// version 2: back-transform block of vectors with GEMM
// zero out below vector
for( k=ki+1; k < n; ++k ) {
*work(k,iv) = c_zero;
}
// Columns iv:nb of work are valid vectors.
// When the number of vectors stored reaches nb,
// or if this was last vector, do the GEMM
if ( (iv == 1) || (ki == 0) ) {
queue.sync();
time_trsv_sum += timer_stop( time_trsv );
timer_start( time_gemm );
nb2 = nb-iv+1;
n2 = ki+nb-iv+1;
// split gemm into multiple tasks, each doing one block row
for( i=0; i < n; i += gemm_nb ) {
magma_int_t ib = min( gemm_nb, n-i );
queue.push_task( new zgemm_task(
MagmaNoTrans, MagmaNoTrans, ib, nb2, n2, c_one,
VR(i,0), ldvr,
work(0,iv ), n, c_zero,
work(i,nb+iv), n ));
}
queue.sync();
time_gemm_sum += timer_stop( time_gemm );
// normalize vectors
// TODO if somev, should copy vectors individually to correct location.
for( k = iv; k <= nb; ++k ) {
ii = blasf77_izamax( &n, work(0,nb+k), &ione ) - 1;
remax = 1. / MAGMA_Z_ABS1( *work(ii,nb+k) );
blasf77_zdscal( &n, &remax, work(0,nb+k), &ione );
}
lapackf77_zlacpy( "F", &n, &nb2, work(0,nb+iv), &n, VR(0,ki), &ldvr );
iv = nb;
timer_start( time_trsv );
}
else {
iv -= 1;
}
} // blocked back-transform
is -= 1;
}
}
timer_stop( time_trsv );
timer_stop( time_total );
timer_printf( "trevc trsv %.4f, gemm %.4f, gemv %.4f, total %.4f\n",
time_trsv_sum, time_gemm_sum, time_gemv_sum, time_total );
if ( leftv ) {
// ============================================================
// Compute left eigenvectors.
// iv is index of column in current block.
// Non-blocked version always uses iv=1;
// blocked version starts with iv=1, goes up to nb.
// (Note the "0-th" column is used to store the original diagonal.)
iv = 1;
is = 0;
for( ki=0; ki < n; ++ki ) {
if ( somev ) {
if ( ! select[ki] ) {
continue;
}
}
//smin = max( ulp*MAGMA_Z_ABS1( *T(ki,ki) ), smlnum );
// --------------------------------------------------------
// Complex left eigenvector
*work(ki,iv) = c_one;
// Form right-hand side.
for( k = ki + 1; k < n; ++k ) {
*work(k,iv) = -MAGMA_Z_CONJ( *T(ki,k) );
}
// Solve conjugate-transposed triangular system:
// [ T(ki+1:n,ki+1:n) - T(ki,ki) ]**H * X = scale*work.
// TODO what happens with T(k,k) - lambda is small? Used to have < smin test.
if ( ki < n-1 ) {
n2 = n-ki-1;
queue.push_task( new magma_zlatrsd_task(
MagmaUpper, MagmaConjTrans, MagmaNonUnit, MagmaTrue,
n2, T(ki+1,ki+1), ldt, *T(ki,ki),
work(ki+1,iv), work(ki,iv), rwork ));
}
// Copy the vector x or Q*x to VL and normalize.
if ( ! over ) {
// ------------------------------
// no back-transform: copy x to VL and normalize
queue.sync();
n2 = n-ki;
blasf77_zcopy( &n2, work(ki,iv), &ione, VL(ki,is), &ione );
ii = blasf77_izamax( &n2, VL(ki,is), &ione ) + ki - 1;
remax = 1. / MAGMA_Z_ABS1( *VL(ii,is) );
blasf77_zdscal( &n2, &remax, VL(ki,is), &ione );
for( k=0; k < ki; ++k ) {
*VL(k,is) = c_zero;
}
}
else if ( version == 1 ) {
// ------------------------------
// version 1: back-transform each vector with GEMV, Q*x.
queue.sync();
if ( ki < n-1 ) {
n2 = n-ki-1;
blasf77_zgemv( "n", &n, &n2, &c_one,
VL(0,ki+1), &ldvl,
work(ki+1,iv), &ione,
work(ki, iv), VL(0,ki), &ione );
}
ii = blasf77_izamax( &n, VL(0,ki), &ione ) - 1;
remax = 1. / MAGMA_Z_ABS1( *VL(ii,ki) );
blasf77_zdscal( &n, &remax, VL(0,ki), &ione );
}
else if ( version == 2 ) {
// ------------------------------
// version 2: back-transform block of vectors with GEMM
// zero out above vector
// could go from (ki+1)-NV+1 to ki
for( k=0; k < ki; ++k ) {
*work(k,iv) = c_zero;
}
// Columns 1:iv of work are valid vectors.
// When the number of vectors stored reaches nb,
// or if this was last vector, do the GEMM
if ( (iv == nb) || (ki == n-1) ) {
queue.sync();
n2 = n-(ki+1)+iv;
// split gemm into multiple tasks, each doing one block row
for( i=0; i < n; i += gemm_nb ) {
magma_int_t ib = min( gemm_nb, n-i );
queue.push_task( new zgemm_task(
MagmaNoTrans, MagmaNoTrans, ib, iv, n2, c_one,
VL(i,ki-iv+1), ldvl,
work(ki-iv+1,1), n, c_zero,
work(i,nb+1), n ));
}
queue.sync();
// normalize vectors
for( k=1; k <= iv; ++k ) {
ii = blasf77_izamax( &n, work(0,nb+k), &ione ) - 1;
remax = 1. / MAGMA_Z_ABS1( *work(ii,nb+k) );
blasf77_zdscal( &n, &remax, work(0,nb+k), &ione );
}
lapackf77_zlacpy( "F", &n, &iv, work(0,nb+1), &n, VL(0,ki-iv+1), &ldvl );
iv = 1;
}
else {
iv += 1;
}
} // blocked back-transform
is += 1;
}
}
// close down threads
queue.quit();
magma_set_lapack_numthreads( lapack_nthread );
return *info;
} // End of ZTREVC
extern "C" magma_int_t
magma_dbulge_back(
magma_uplo_t uplo,
magma_int_t n, magma_int_t nb,
magma_int_t ne, magma_int_t Vblksiz,
double *Z, magma_int_t ldz,
magmaDouble_ptr dZ, magma_int_t lddz,
double *V, magma_int_t ldv,
double *TAU,
double *T, magma_int_t ldt,
magma_int_t* info)
{
magma_int_t threads = magma_get_parallel_numthreads();
magma_int_t mklth = magma_get_lapack_numthreads();
magma_set_lapack_numthreads(1);
real_Double_t timeaplQ2=0.0;
double f= 1.;
magma_int_t n_gpu = ne;
//#if defined(PRECISION_s) || defined(PRECISION_d)
//double gpu_cpu_perf = 50; // gpu over cpu performance //100% ev // SandyB. - Kepler (K20c)
//double gpu_cpu_perf = 16; // gpu over cpu performance //100% ev // SandyB. - Fermi (M2090)
//#else
// double gpu_cpu_perf = 27.5; // gpu over cpu performance //100% ev // Westmere - Fermi (M2090)
//double gpu_cpu_perf = 37; // gpu over cpu performance //100% ev // SandyB. - Kepler (K20c)
// double gpu_cpu_perf = 130; // gpu over cpu performance //100% ev // Bulldozer - Kepler (K20X)
//#endif
magma_int_t gpu_cpu_perf = magma_get_dbulge_gcperf();
if (threads > 1) {
f = 1. / (1. + (double)(threads-1)/ ((double)gpu_cpu_perf) );
n_gpu = (magma_int_t)(f*ne);
}
/****************************************************
* apply V2 from left to the eigenvectors Z. dZ = (I-V2*T2*V2')*Z
* **************************************************/
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//n_gpu=ne;
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
timeaplQ2 = magma_wtime();
/*============================
* use GPU+CPU's
*==========================*/
if (n_gpu < ne) {
// define the size of Q to be done on CPU's and the size on GPU's
// note that GPU use Q(1:N_GPU) and CPU use Q(N_GPU+1:N)
#ifdef ENABLE_DEBUG
printf("---> calling GPU + CPU(if N_CPU > 0) to apply V2 to Z with NE %d N_GPU %d N_CPU %d\n",ne, n_gpu, ne-n_gpu);
#endif
magma_dapplyQ_data data_applyQ;
magma_dapplyQ_data_init(&data_applyQ, threads, n, ne, n_gpu, nb, Vblksiz, Z, ldz, V, ldv, TAU, T, ldt, dZ, lddz);
magma_dapplyQ_id_data* arg;
magma_malloc_cpu((void**) &arg, threads*sizeof(magma_dapplyQ_id_data));
pthread_t* thread_id;
magma_malloc_cpu((void**) &thread_id, threads*sizeof(pthread_t));
pthread_attr_t thread_attr;
// ===============================
// relaunch thread to apply Q
// ===============================
// Set one thread per core
pthread_attr_init(&thread_attr);
pthread_attr_setscope(&thread_attr, PTHREAD_SCOPE_SYSTEM);
pthread_setconcurrency(threads);
// Launch threads
for (magma_int_t thread = 1; thread < threads; thread++) {
magma_dapplyQ_id_data_init(&(arg[thread]), thread, &data_applyQ);
pthread_create(&thread_id[thread], &thread_attr, magma_dapplyQ_parallel_section, &arg[thread]);
}
magma_dapplyQ_id_data_init(&(arg[0]), 0, &data_applyQ);
magma_dapplyQ_parallel_section(&arg[0]);
// Wait for completion
for (magma_int_t thread = 1; thread < threads; thread++) {
void *exitcodep;
pthread_join(thread_id[thread], &exitcodep);
}
magma_free_cpu(thread_id);
magma_free_cpu(arg);
magma_dapplyQ_data_destroy(&data_applyQ);
magma_dsetmatrix(n, ne-n_gpu, Z + n_gpu*ldz, ldz, dZ + n_gpu*ldz, lddz);
/*============================
* use only GPU
*==========================*/
} else {
magma_dsetmatrix(n, ne, Z, ldz, dZ, lddz);
magma_dbulge_applyQ_v2(MagmaLeft, ne, n, nb, Vblksiz, dZ, lddz, V, ldv, T, ldt, info);
magma_device_sync();
}
timeaplQ2 = magma_wtime()-timeaplQ2;
magma_set_lapack_numthreads(mklth);
return MAGMA_SUCCESS;
}
extern "C" magma_int_t
magma_zbulge_back_m(
magma_int_t ngpu,
magma_uplo_t uplo,
magma_int_t n, magma_int_t nb,
magma_int_t ne, magma_int_t Vblksiz,
magmaDoubleComplex *Z, magma_int_t ldz,
magmaDoubleComplex *V, magma_int_t ldv,
magmaDoubleComplex *TAU,
magmaDoubleComplex *T, magma_int_t ldt,
magma_int_t* info)
{
magma_int_t threads = magma_get_parallel_numthreads();
magma_int_t mklth = magma_get_lapack_numthreads();
magma_set_lapack_numthreads(1);
real_Double_t timeaplQ2=0.0;
double f= 1.;
magma_int_t n_gpu = ne;
//#if defined(PRECISION_s) || defined(PRECISION_d)
// double gpu_cpu_perf = 32; //gpu over cpu performance
//#else
// double gpu_cpu_perf = 32; // gpu over cpu performance
//#endif
double perf_temp= .85;
double perf_temp2= perf_temp;
for (magma_int_t itmp=1; itmp < ngpu; ++itmp)
perf_temp2 *= perf_temp;
magma_int_t gpu_cpu_perf = magma_get_zbulge_gcperf();
if (threads > 1) {
f = 1. / (1. + (double)(threads-1)/ ((double)gpu_cpu_perf*(1.-perf_temp2)/(1.-perf_temp)));
n_gpu = (magma_int_t)(f*ne);
}
/****************************************************
* apply V2 from left to the eigenvectors Z. dZ = (I-V2*T2*V2')*Z
* **************************************************/
timeaplQ2 = magma_wtime();
/*============================
* use GPU+CPU's
*==========================*/
//n_gpu = ne;
if (n_gpu < ne) {
// define the size of Q to be done on CPU's and the size on GPU's
// note that GPU use Q(1:N_GPU) and CPU use Q(N_GPU+1:N)
#ifdef ENABLE_DEBUG
printf("---> calling GPU + CPU(if N_CPU > 0) to apply V2 to Z with NE %d N_GPU %d N_CPU %d\n",ne, n_gpu, ne-n_gpu);
#endif
magma_zapplyQ_m_data data_applyQ(ngpu, threads, n, ne, n_gpu, nb, Vblksiz, Z, ldz, V, ldv, TAU, T, ldt);
magma_zapplyQ_m_id_data* arg;
magma_malloc_cpu((void**) &arg, threads*sizeof(magma_zapplyQ_m_id_data));
pthread_t* thread_id;
magma_malloc_cpu((void**) &thread_id, threads*sizeof(pthread_t));
pthread_attr_t thread_attr;
// ===============================
// relaunch thread to apply Q
// ===============================
// Set one thread per core
pthread_attr_init(&thread_attr);
pthread_attr_setscope(&thread_attr, PTHREAD_SCOPE_SYSTEM);
pthread_setconcurrency(threads);
// Launch threads
for (magma_int_t thread = 1; thread < threads; thread++) {
arg[thread] = magma_zapplyQ_m_id_data(thread, &data_applyQ);
pthread_create(&thread_id[thread], &thread_attr, magma_zapplyQ_m_parallel_section, &arg[thread]);
}
arg[0] = magma_zapplyQ_m_id_data(0, &data_applyQ);
magma_zapplyQ_m_parallel_section(&arg[0]);
// Wait for completion
for (magma_int_t thread = 1; thread < threads; thread++) {
void *exitcodep;
pthread_join(thread_id[thread], &exitcodep);
}
magma_free_cpu(thread_id);
magma_free_cpu(arg);
/*============================
* use only GPU
*==========================*/
} else {
magma_zbulge_applyQ_v2_m(ngpu, MagmaLeft, ne, n, nb, Vblksiz, Z, ldz, V, ldv, T, ldt, info);
magma_device_sync();
}
timeaplQ2 = magma_wtime()-timeaplQ2;
magma_set_lapack_numthreads(mklth);
return MAGMA_SUCCESS;
}
/* ////////////////////////////////////////////////////////////////////////////
-- Testing zhegvdx
*/
int main( int argc, char** argv)
{
TESTING_INIT();
real_Double_t gpu_time;
magmaDoubleComplex *h_A, *h_R, *h_B, *h_S, *h_work;
#if defined(PRECISION_z) || defined(PRECISION_c)
double *rwork;
magma_int_t lrwork;
#endif
/* Matrix size */
double *w1, *w2, result[2]={0,0};
magma_int_t *iwork;
magma_int_t N, n2, info, lwork, liwork;
magmaDoubleComplex c_zero = MAGMA_Z_ZERO;
magmaDoubleComplex c_one = MAGMA_Z_ONE;
magmaDoubleComplex c_neg_one = MAGMA_Z_NEG_ONE;
magma_int_t ione = 1;
magma_int_t ISEED[4] = {0,0,0,1};
magma_int_t status = 0;
magma_opts opts;
parse_opts( argc, argv, &opts );
double tol = opts.tolerance * lapackf77_dlamch("E");
double tolulp = opts.tolerance * lapackf77_dlamch("P");
magma_range_t range = MagmaRangeAll;
if (opts.fraction != 1)
range = MagmaRangeI;
if ( opts.check && opts.jobz == MagmaNoVec ) {
fprintf( stderr, "checking results requires vectors; setting jobz=V (option -JV)\n" );
opts.jobz = MagmaVec;
}
printf("using: itype = %d, jobz = %s, range = %s, uplo = %s, opts.check = %d, fraction = %6.4f\n",
(int) opts.itype, lapack_vec_const(opts.jobz), lapack_range_const(range), lapack_uplo_const(opts.uplo),
(int) opts.check, opts.fraction);
printf(" N M GPU Time (sec)\n");
printf("============================\n");
magma_int_t threads = magma_get_parallel_numthreads();
for( int itest = 0; itest < opts.ntest; ++itest ) {
for( int iter = 0; iter < opts.niter; ++iter ) {
N = opts.nsize[itest];
n2 = N*N;
#if defined(PRECISION_z) || defined(PRECISION_c)
lwork = magma_zbulge_get_lq2(N, threads) + 2*N + N*N;
lrwork = 1 + 5*N +2*N*N;
#else
lwork = magma_zbulge_get_lq2(N, threads) + 1 + 6*N + 2*N*N;
#endif
liwork = 3 + 5*N;
/* Allocate host memory for the matrix */
TESTING_MALLOC_CPU( h_A, magmaDoubleComplex, n2 );
TESTING_MALLOC_CPU( h_B, magmaDoubleComplex, n2 );
TESTING_MALLOC_CPU( w1, double, N );
TESTING_MALLOC_CPU( w2, double, N );
TESTING_MALLOC_CPU( iwork, magma_int_t, liwork );
TESTING_MALLOC_PIN( h_R, magmaDoubleComplex, n2 );
TESTING_MALLOC_PIN( h_S, magmaDoubleComplex, n2 );
TESTING_MALLOC_PIN( h_work, magmaDoubleComplex, lwork );
#if defined(PRECISION_z) || defined(PRECISION_c)
TESTING_MALLOC_PIN( rwork, double, lrwork);
#endif
/* Initialize the matrix */
lapackf77_zlarnv( &ione, ISEED, &n2, h_A );
lapackf77_zlarnv( &ione, ISEED, &n2, h_B );
magma_zmake_hpd( N, h_B, N );
magma_zmake_hermitian( N, h_A, N );
magma_int_t m1 = 0;
double vl = 0;
double vu = 0;
magma_int_t il = 0;
magma_int_t iu = 0;
if (range == MagmaRangeI) {
il = 1;
iu = (int) (opts.fraction*N);
}
// ==================================================================
// Warmup using MAGMA
// ==================================================================
if (opts.warmup) {
lapackf77_zlacpy( MagmaUpperLowerStr, &N, &N, h_A, &N, h_R, &N );
lapackf77_zlacpy( MagmaUpperLowerStr, &N, &N, h_B, &N, h_S, &N );
magma_zhegvdx_2stage(opts.itype, opts.jobz, range, opts.uplo,
N, h_R, N, h_S, N, vl, vu, il, iu, &m1, w1,
h_work, lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, lrwork,
#endif
iwork, liwork,
&info);
}
// ===================================================================
// Performs operation using MAGMA
// ===================================================================
lapackf77_zlacpy( MagmaUpperLowerStr, &N, &N, h_A, &N, h_R, &N );
lapackf77_zlacpy( MagmaUpperLowerStr, &N, &N, h_B, &N, h_S, &N );
gpu_time = magma_wtime();
magma_zhegvdx_2stage(opts.itype, opts.jobz, range, opts.uplo,
N, h_R, N, h_S, N, vl, vu, il, iu, &m1, w1,
h_work, lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, lrwork,
#endif
iwork, liwork,
&info);
gpu_time = magma_wtime() - gpu_time;
if ( opts.check && opts.jobz != MagmaNoVec ) {
/* =====================================================================
Check the results following the LAPACK's [zc]hegvdx routine.
A x = lambda B x is solved
and the following 3 tests computed:
(1) | A Z - B Z D | / ( |A||Z| N ) (itype = 1)
| A B Z - Z D | / ( |A||Z| N ) (itype = 2)
| B A Z - Z D | / ( |A||Z| N ) (itype = 3)
(2) | S(with V) - S(w/o V) | / | S |
=================================================================== */
#if defined(PRECISION_d) || defined(PRECISION_s)
double *rwork = h_work + N*N;
#endif
result[0] = 1.;
result[0] /= lapackf77_zlanhe("1", lapack_uplo_const(opts.uplo), &N, h_A, &N, rwork);
result[0] /= lapackf77_zlange("1", &N, &m1, h_R, &N, rwork);
if (opts.itype == 1) {
blasf77_zhemm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_A, &N, h_R, &N, &c_zero, h_work, &N);
for(int i=0; i<m1; ++i)
blasf77_zdscal(&N, &w1[i], &h_R[i*N], &ione);
blasf77_zhemm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_neg_one, h_B, &N, h_R, &N, &c_one, h_work, &N);
result[0] *= lapackf77_zlange("1", &N, &m1, h_work, &N, rwork)/N;
}
else if (opts.itype == 2) {
blasf77_zhemm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_B, &N, h_R, &N, &c_zero, h_work, &N);
for(int i=0; i<m1; ++i)
blasf77_zdscal(&N, &w1[i], &h_R[i*N], &ione);
blasf77_zhemm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_A, &N, h_work, &N, &c_neg_one, h_R, &N);
result[0] *= lapackf77_zlange("1", &N, &m1, h_R, &N, rwork)/N;
}
else if (opts.itype == 3) {
blasf77_zhemm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_A, &N, h_R, &N, &c_zero, h_work, &N);
for(int i=0; i<m1; ++i)
blasf77_zdscal(&N, &w1[i], &h_R[i*N], &ione);
blasf77_zhemm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_B, &N, h_work, &N, &c_neg_one, h_R, &N);
result[0] *= lapackf77_zlange("1", &N, &m1, h_R, &N, rwork)/N;
}
lapackf77_zlacpy( MagmaUpperLowerStr, &N, &N, h_A, &N, h_R, &N );
lapackf77_zlacpy( MagmaUpperLowerStr, &N, &N, h_B, &N, h_S, &N );
magma_int_t m2 = m1;
lapackf77_zhegvd(&opts.itype, "N", lapack_uplo_const(opts.uplo), &N,
h_R, &N, h_S, &N, w2,
h_work, &lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, &lrwork,
#endif
iwork, &liwork,
&info);
double maxw=0, diff=0;
for(int j=0; j<m2; j++) {
maxw = max(maxw, fabs(w1[j]));
maxw = max(maxw, fabs(w2[j]));
diff = max(diff, fabs(w1[j] - w2[j]));
}
result[1] = diff / (m2*maxw);
}
/* =====================================================================
Print execution time
=================================================================== */
printf("%5d %5d %7.2f\n",
(int) N, (int) m1, gpu_time);
if ( opts.check && opts.jobz != MagmaNoVec ) {
printf("Testing the eigenvalues and eigenvectors for correctness:\n");
if (opts.itype==1) {
printf(" | A Z - B Z D | / (|A| |Z| N) = %8.2e %s\n", result[0], (result[0] < tol ? "ok" : "failed"));
}
else if (opts.itype==2) {
printf(" | A B Z - Z D | / (|A| |Z| N) = %8.2e %s\n", result[0], (result[0] < tol ? "ok" : "failed"));
}
else if (opts.itype==3) {
printf(" | B A Z - Z D | / (|A| |Z| N) = %8.2e %s\n", result[0], (result[0] < tol ? "ok" : "failed"));
}
printf( " | D(w/ Z) - D(w/o Z) | / |D| = %8.2e %s\n\n", result[1], (result[1] < tolulp ? "ok" : "failed"));
status += ! (result[0] < tol && result[1] < tolulp);
}
TESTING_FREE_CPU( h_A );
TESTING_FREE_CPU( h_B );
TESTING_FREE_CPU( w1 );
TESTING_FREE_CPU( w2 );
TESTING_FREE_CPU( iwork );
TESTING_FREE_PIN( h_R );
TESTING_FREE_PIN( h_S );
TESTING_FREE_PIN( h_work );
#if defined(PRECISION_z) || defined(PRECISION_c)
TESTING_FREE_PIN( rwork );
#endif
fflush( stdout );
}
if ( opts.niter > 1 ) {
printf( "\n" );
}
}
/* Shutdown */
TESTING_FINALIZE();
return status;
}
/* ////////////////////////////////////////////////////////////////////////////
-- Testing chegvdx
*/
int main( int argc, char** argv)
{
TESTING_INIT();
/* Constants */
const magmaFloatComplex c_zero = MAGMA_C_ZERO;
const magmaFloatComplex c_one = MAGMA_C_ONE;
const magmaFloatComplex c_neg_one = MAGMA_C_NEG_ONE;
const magma_int_t ione = 1;
/* Local variables */
real_Double_t gpu_time;
magmaFloatComplex *h_A, *h_R, *h_B, *h_S, *h_work;
#ifdef COMPLEX
float *rwork;
magma_int_t lrwork;
#endif
float *w1, *w2, result[2]={0,0};
magma_int_t *iwork;
magma_int_t N, n2, info, lda, lwork, liwork;
magma_int_t ISEED[4] = {0,0,0,1};
magma_int_t status = 0;
magma_opts opts;
opts.parse_opts( argc, argv );
float tol = opts.tolerance * lapackf77_slamch("E");
float tolulp = opts.tolerance * lapackf77_slamch("P");
magma_range_t range = MagmaRangeAll;
if (opts.fraction != 1)
range = MagmaRangeI;
// pass ngpu = -1 to test multi-GPU code using 1 gpu
magma_int_t abs_ngpu = abs( opts.ngpu );
printf("%% itype = %d, jobz = %s, range = %s, uplo = %s, fraction = %6.4f, ngpu = %d\n",
int(opts.itype), lapack_vec_const(opts.jobz), lapack_range_const(range), lapack_uplo_const(opts.uplo),
opts.fraction, int(abs_ngpu) );
if (opts.itype == 1) {
printf("%% N M GPU Time (sec) |AZ-BZD| |D - D_magma|\n");
}
else if (opts.itype == 2) {
printf("%% N M GPU Time (sec) |ABZ-ZD| |D - D_magma|\n");
}
else if (opts.itype == 3) {
printf("%% N M GPU Time (sec) |BAZ-ZD| |D - D_magma|\n");
}
printf("%%======================================================\n");
magma_int_t threads = magma_get_parallel_numthreads();
for( int itest = 0; itest < opts.ntest; ++itest ) {
for( int iter = 0; iter < opts.niter; ++iter ) {
N = opts.nsize[itest];
lda = N;
n2 = lda*N;
// TODO: test vl-vu range
magma_int_t m1 = 0;
float vl = 0;
float vu = 0;
magma_int_t il = 0;
magma_int_t iu = 0;
if (opts.fraction == 0) {
il = max( 1, magma_int_t(0.1*N) );
iu = max( 1, magma_int_t(0.3*N) );
}
else {
il = 1;
iu = max( 1, magma_int_t(opts.fraction*N) );
}
magma_cheevdx_getworksize(N, threads, (opts.jobz == MagmaVec),
&lwork,
#ifdef COMPLEX
&lrwork,
#endif
&liwork);
/* Allocate host memory for the matrix */
TESTING_MALLOC_CPU( h_A, magmaFloatComplex, n2 );
TESTING_MALLOC_CPU( h_B, magmaFloatComplex, n2 );
TESTING_MALLOC_CPU( w1, float, N );
TESTING_MALLOC_CPU( w2, float, N );
TESTING_MALLOC_CPU( iwork, magma_int_t, liwork );
TESTING_MALLOC_PIN( h_R, magmaFloatComplex, n2 );
TESTING_MALLOC_PIN( h_S, magmaFloatComplex, n2 );
TESTING_MALLOC_PIN( h_work, magmaFloatComplex, max( lwork, N*N )); // check needs N*N
#ifdef COMPLEX
TESTING_MALLOC_PIN( rwork, float, lrwork);
#endif
/* Initialize the matrix */
lapackf77_clarnv( &ione, ISEED, &n2, h_A );
lapackf77_clarnv( &ione, ISEED, &n2, h_B );
magma_cmake_hpd( N, h_B, lda );
magma_cmake_hermitian( N, h_A, lda );
lapackf77_clacpy( MagmaFullStr, &N, &N, h_A, &lda, h_R, &lda );
lapackf77_clacpy( MagmaFullStr, &N, &N, h_B, &lda, h_S, &lda );
// ===================================================================
// Performs operation using MAGMA
// ===================================================================
gpu_time = magma_wtime();
if (opts.ngpu == 1) {
magma_chegvdx_2stage( opts.itype, opts.jobz, range, opts.uplo,
N, h_R, lda, h_S, lda, vl, vu, il, iu, &m1, w1,
h_work, lwork,
#ifdef COMPLEX
rwork, lrwork,
#endif
iwork, liwork,
&info );
}
else {
magma_chegvdx_2stage_m( abs_ngpu, opts.itype, opts.jobz, range, opts.uplo,
N, h_R, lda, h_S, lda, vl, vu, il, iu, &m1, w1,
h_work, lwork,
#ifdef COMPLEX
rwork, lrwork,
#endif
iwork, liwork,
&info );
}
gpu_time = magma_wtime() - gpu_time;
if (info != 0) {
printf("magma_chegvdx_2stage returned error %d: %s.\n",
(int) info, magma_strerror( info ));
}
if ( opts.check ) {
/* =====================================================================
Check the results following the LAPACK's [zc]hegvdx routine.
A x = lambda B x is solved
and the following 3 tests computed:
(1) | A Z - B Z D | / ( |A| |Z| N ) (itype = 1)
| A B Z - Z D | / ( |A| |Z| N ) (itype = 2)
| B A Z - Z D | / ( |A| |Z| N ) (itype = 3)
(2) | D(with V, magma) - D(w/o V, lapack) | / | D |
=================================================================== */
#ifdef REAL
float *rwork = h_work + N*N;
#endif
if ( opts.jobz != MagmaNoVec ) {
result[0] = 1.;
result[0] /= safe_lapackf77_clanhe("1", lapack_uplo_const(opts.uplo), &N, h_A, &lda, rwork);
result[0] /= lapackf77_clange("1", &N, &m1, h_R, &lda, rwork);
if (opts.itype == 1) {
blasf77_chemm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_A, &lda, h_R, &lda, &c_zero, h_work, &N);
for (int i=0; i < m1; ++i)
blasf77_csscal(&N, &w1[i], &h_R[i*N], &ione);
blasf77_chemm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_neg_one, h_B, &lda, h_R, &lda, &c_one, h_work, &N);
result[0] *= lapackf77_clange("1", &N, &m1, h_work, &N, rwork)/N;
}
else if (opts.itype == 2) {
blasf77_chemm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_B, &lda, h_R, &lda, &c_zero, h_work, &N);
for (int i=0; i < m1; ++i)
blasf77_csscal(&N, &w1[i], &h_R[i*N], &ione);
blasf77_chemm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_A, &lda, h_work, &N, &c_neg_one, h_R, &lda);
result[0] *= lapackf77_clange("1", &N, &m1, h_R, &lda, rwork)/N;
}
else if (opts.itype == 3) {
blasf77_chemm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_A, &lda, h_R, &lda, &c_zero, h_work, &N);
for (int i=0; i < m1; ++i)
blasf77_csscal(&N, &w1[i], &h_R[i*N], &ione);
blasf77_chemm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_B, &lda, h_work, &N, &c_neg_one, h_R, &lda);
result[0] *= lapackf77_clange("1", &N, &m1, h_R, &lda, rwork)/N;
}
}
lapackf77_clacpy( MagmaFullStr, &N, &N, h_A, &lda, h_R, &lda );
lapackf77_clacpy( MagmaFullStr, &N, &N, h_B, &lda, h_S, &lda );
lapackf77_chegvd( &opts.itype, "N", lapack_uplo_const(opts.uplo), &N,
h_R, &lda, h_S, &lda, w2,
h_work, &lwork,
#ifdef COMPLEX
rwork, &lrwork,
#endif
iwork, &liwork,
&info );
if (info != 0) {
printf("lapackf77_chegvd returned error %d: %s.\n",
(int) info, magma_strerror( info ));
}
float maxw=0, diff=0;
for (int j=0; j < m1; j++) {
maxw = max(maxw, fabs(w1[j]));
maxw = max(maxw, fabs(w2[j]));
diff = max(diff, fabs(w1[j] - w2[j]));
}
result[1] = diff / (m1*maxw);
}
/* =====================================================================
Print execution time
=================================================================== */
printf("%5d %5d %9.4f ",
(int) N, (int) m1, gpu_time);
if ( opts.check ) {
bool okay = (result[1] < tolulp);
if ( opts.jobz != MagmaNoVec ) {
okay = okay && (result[0] < tol);
printf(" %8.2e", result[0] );
}
else {
printf(" --- ");
}
printf(" %8.2e %s\n", result[1], (okay ? "ok" : "failed"));
status += ! okay;
}
else {
printf(" ---\n");
}
TESTING_FREE_CPU( h_A );
TESTING_FREE_CPU( h_B );
TESTING_FREE_CPU( w1 );
TESTING_FREE_CPU( w2 );
TESTING_FREE_CPU( iwork );
TESTING_FREE_PIN( h_R );
TESTING_FREE_PIN( h_S );
TESTING_FREE_PIN( h_work );
#ifdef COMPLEX
TESTING_FREE_PIN( rwork );
#endif
fflush( stdout );
}
if ( opts.niter > 1 ) {
printf( "\n" );
}
}
opts.cleanup();
TESTING_FINALIZE();
return status;
}
/* ////////////////////////////////////////////////////////////////////////////
-- Testing ssygvdx
*/
int main( int argc, char** argv)
{
TESTING_INIT_MGPU();
real_Double_t mgpu_time;
float *h_A, *h_Ainit, *h_B, *h_Binit, *h_work;
#if defined(PRECISION_z) || defined(PRECISION_c)
float *rwork;
magma_int_t lrwork;
#endif
float *w1, result=0;
magma_int_t *iwork;
magma_int_t N, n2, info, lwork, liwork;
float c_zero = MAGMA_S_ZERO;
float c_one = MAGMA_S_ONE;
float c_neg_one = MAGMA_S_NEG_ONE;
magma_int_t ione = 1;
magma_int_t ISEED[4] = {0,0,0,1};
magma_int_t status = 0;
magma_opts opts;
parse_opts( argc, argv, &opts );
float tol = opts.tolerance * lapackf77_slamch("E");
magma_range_t range = MagmaRangeAll;
if (opts.fraction != 1)
range = MagmaRangeI;
if ( opts.check && opts.jobz == MagmaNoVec ) {
fprintf( stderr, "checking results requires vectors; setting jobz=V (option -JV)\n" );
opts.jobz = MagmaVec;
}
printf("using: ngpu = %d, itype = %d, jobz = %s, range = %s, uplo = %s, opts.check = %d, fraction = %6.4f\n",
(int) opts.ngpu, (int) opts.itype,
lapack_vec_const(opts.jobz), lapack_range_const(range), lapack_uplo_const(opts.uplo),
(int) opts.check, opts.fraction);
printf(" N M ngpu MGPU Time (sec)\n");
printf("====================================\n");
magma_int_t threads = magma_get_parallel_numthreads();
for( int itest = 0; itest < opts.ntest; ++itest ) {
for( int iter = 0; iter < opts.niter; ++iter ) {
N = opts.nsize[itest];
n2 = N*N;
#if defined(PRECISION_z) || defined(PRECISION_c)
lwork = magma_sbulge_get_lq2(N, threads) + 2*N + N*N;
lrwork = 1 + 5*N +2*N*N;
#else
lwork = magma_sbulge_get_lq2(N, threads) + 1 + 6*N + 2*N*N;
#endif
liwork = 3 + 5*N;
//magma_int_t NB = 96;//magma_bulge_get_nb(N);
//magma_int_t sizvblg = magma_sbulge_get_lq2(N, threads);
//magma_int_t siz = max(sizvblg,n2)+2*(N*NB+N)+24*N;
/* Allocate host memory for the matrix */
TESTING_MALLOC_PIN( h_A, float, n2 );
TESTING_MALLOC_PIN( h_B, float, n2 );
TESTING_MALLOC_PIN( h_work, float, lwork );
#if defined(PRECISION_z) || defined(PRECISION_c)
TESTING_MALLOC_PIN( rwork, float, lrwork);
#endif
TESTING_MALLOC_CPU( w1, float, N );
TESTING_MALLOC_CPU( iwork, magma_int_t, liwork);
/* Initialize the matrix */
lapackf77_slarnv( &ione, ISEED, &n2, h_A );
lapackf77_slarnv( &ione, ISEED, &n2, h_B );
magma_smake_hpd( N, h_B, N );
magma_smake_symmetric( N, h_A, N );
if ( opts.warmup || opts.check ) {
TESTING_MALLOC_CPU( h_Ainit, float, n2 );
TESTING_MALLOC_CPU( h_Binit, float, n2 );
lapackf77_slacpy( MagmaUpperLowerStr, &N, &N, h_A, &N, h_Ainit, &N );
lapackf77_slacpy( MagmaUpperLowerStr, &N, &N, h_B, &N, h_Binit, &N );
}
magma_int_t m1 = 0;
float vl = 0;
float vu = 0;
magma_int_t il = 0;
magma_int_t iu = 0;
if (range == MagmaRangeI) {
il = 1;
iu = (int) (opts.fraction*N);
}
if ( opts.warmup ) {
// ==================================================================
// Warmup using MAGMA. I prefer to use smalltest to warmup A-
// ==================================================================
magma_ssygvdx_2stage_m(opts.ngpu, opts.itype, opts.jobz, range, opts.uplo,
N, h_A, N, h_B, N, vl, vu, il, iu, &m1, w1,
h_work, lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, lrwork,
#endif
iwork, liwork,
&info);
lapackf77_slacpy( MagmaUpperLowerStr, &N, &N, h_Ainit, &N, h_A, &N );
lapackf77_slacpy( MagmaUpperLowerStr, &N, &N, h_Binit, &N, h_B, &N );
}
// ===================================================================
// Performs operation using MAGMA
// ===================================================================
mgpu_time = magma_wtime();
magma_ssygvdx_2stage_m(opts.ngpu, opts.itype, opts.jobz, range, opts.uplo,
N, h_A, N, h_B, N, vl, vu, il, iu, &m1, w1,
h_work, lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, lrwork,
#endif
iwork, liwork,
&info);
mgpu_time = magma_wtime() - mgpu_time;
if ( opts.check ) {
// ===================================================================
// Check the results following the LAPACK's [zc]hegvdx routine.
// A x = lambda B x is solved
// and the following 3 tests computed:
// (1) | A Z - B Z D | / ( |A||Z| N ) (itype = 1)
// | A B Z - Z D | / ( |A||Z| N ) (itype = 2)
// | B A Z - Z D | / ( |A||Z| N ) (itype = 3)
// ===================================================================
#if defined(PRECISION_d) || defined(PRECISION_s)
float *rwork = h_work + N*N;
#endif
result = 1.;
result /= lapackf77_slansy("1", lapack_uplo_const(opts.uplo), &N, h_Ainit, &N, rwork);
result /= lapackf77_slange("1", &N , &m1, h_A, &N, rwork);
if (opts.itype == 1) {
blasf77_ssymm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_Ainit, &N, h_A, &N, &c_zero, h_work, &N);
for(int i=0; i<m1; ++i)
blasf77_sscal(&N, &w1[i], &h_A[i*N], &ione);
blasf77_ssymm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_neg_one, h_Binit, &N, h_A, &N, &c_one, h_work, &N);
result *= lapackf77_slange("1", &N, &m1, h_work, &N, rwork)/N;
}
else if (opts.itype == 2) {
blasf77_ssymm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_Binit, &N, h_A, &N, &c_zero, h_work, &N);
for(int i=0; i<m1; ++i)
blasf77_sscal(&N, &w1[i], &h_A[i*N], &ione);
blasf77_ssymm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_Ainit, &N, h_work, &N, &c_neg_one, h_A, &N);
result *= lapackf77_slange("1", &N, &m1, h_A, &N, rwork)/N;
}
else if (opts.itype == 3) {
blasf77_ssymm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_Ainit, &N, h_A, &N, &c_zero, h_work, &N);
for(int i=0; i<m1; ++i)
blasf77_sscal(&N, &w1[i], &h_A[i*N], &ione);
blasf77_ssymm("L", lapack_uplo_const(opts.uplo), &N, &m1, &c_one, h_Binit, &N, h_work, &N, &c_neg_one, h_A, &N);
result *= lapackf77_slange("1", &N, &m1, h_A, &N, rwork)/N;
}
}
// ===================================================================
// Print execution time
// ===================================================================
printf("%5d %5d %4d %7.2f\n",
(int) N, (int) m1, (int) opts.ngpu, mgpu_time);
if ( opts.check ) {
printf("Testing the eigenvalues and eigenvectors for correctness:\n");
if (opts.itype==1) {
printf("(1) | A Z - B Z D | / (|A| |Z| N) = %8.2e %s\n", result, (result < tol ? "ok" : "failed") );
}
else if (opts.itype==2) {
printf("(1) | A B Z - Z D | / (|A| |Z| N) = %8.2e %s\n", result, (result < tol ? "ok" : "failed") );
}
else if (opts.itype==3) {
printf("(1) | B A Z - Z D | / (|A| |Z| N) = %8.2e %s\n", result, (result < tol ? "ok" : "failed") );
}
printf("\n");
status += ! (result < tol);
}
TESTING_FREE_PIN( h_A );
TESTING_FREE_PIN( h_B );
TESTING_FREE_PIN( h_work );
#if defined(PRECISION_z) || defined(PRECISION_c)
TESTING_FREE_PIN( rwork );
#endif
TESTING_FREE_CPU( w1 );
TESTING_FREE_CPU( iwork );
if ( opts.warmup || opts.check ) {
TESTING_FREE_CPU( h_Ainit );
TESTING_FREE_CPU( h_Binit );
}
fflush( stdout );
}
if ( opts.niter > 1 ) {
printf( "\n" );
}
}
/* Shutdown */
TESTING_FINALIZE_MGPU();
return status;
}
/* ////////////////////////////////////////////////////////////////////////////
-- Testing dsygvdx
*/
int main( int argc, char** argv)
{
TESTING_INIT();
real_Double_t gpu_time;
double *h_A, *h_R, *h_work;
#if defined(PRECISION_z) || defined(PRECISION_c)
double *rwork;
magma_int_t lrwork;
#endif
/* Matrix size */
double *w1, *w2;
magma_int_t *iwork;
magma_int_t N, n2, info, lwork, liwork;
magma_int_t ione = 1;
magma_int_t ISEED[4] = {0,0,0,1};;
magma_int_t info_ortho = 0;
magma_int_t info_solution = 0;
magma_int_t info_reduction = 0;
magma_int_t status = 0;
magma_opts opts;
parse_opts( argc, argv, &opts );
magma_range_t range = MagmaRangeAll;
if (opts.fraction != 1)
range = MagmaRangeI;
if ( opts.check && opts.jobz == MagmaNoVec ) {
fprintf( stderr, "checking results requires vectors; setting jobz=V (option -JV)\n" );
opts.jobz = MagmaVec;
}
printf("using: itype = %d, jobz = %s, range = %s, uplo = %s, check = %d, fraction = %6.4f\n",
(int) opts.itype, lapack_vec_const(opts.jobz), lapack_range_const(range), lapack_uplo_const(opts.uplo),
(int) opts.check, opts.fraction);
printf(" N M GPU Time (sec) ||I-Q'Q||/. ||A-QDQ'||/. ||D-D_magma||/.\n");
printf("=======================================================================\n");
magma_int_t threads = magma_get_parallel_numthreads();
for( int itest = 0; itest < opts.ntest; ++itest ) {
for( int iter = 0; iter < opts.niter; ++iter ) {
N = opts.nsize[itest];
n2 = N*N;
#if defined(PRECISION_z) || defined(PRECISION_c)
lwork = magma_dbulge_get_lq2(N, threads) + 2*N + N*N;
lrwork = 1 + 5*N +2*N*N;
#else
lwork = magma_dbulge_get_lq2(N, threads) + 1 + 6*N + 2*N*N;
#endif
liwork = 3 + 5*N;
/* Allocate host memory for the matrix */
TESTING_MALLOC_CPU( h_A, double, n2 );
TESTING_MALLOC_CPU( w1, double, N );
TESTING_MALLOC_CPU( w2, double, N );
TESTING_MALLOC_CPU( iwork, magma_int_t, liwork );
TESTING_MALLOC_PIN( h_R, double, n2 );
TESTING_MALLOC_PIN( h_work, double, lwork );
#if defined(PRECISION_z) || defined(PRECISION_c)
TESTING_MALLOC_PIN( rwork, double, lrwork );
#endif
/* Initialize the matrix */
lapackf77_dlarnv( &ione, ISEED, &n2, h_A );
magma_dmake_symmetric( N, h_A, N );
magma_int_t m1 = 0;
double vl = 0;
double vu = 0;
magma_int_t il = 0;
magma_int_t iu = 0;
if (range == MagmaRangeI) {
il = 1;
iu = (int) (opts.fraction*N);
}
if (opts.warmup) {
// ==================================================================
// Warmup using MAGMA
// ==================================================================
lapackf77_dlacpy( MagmaUpperLowerStr, &N, &N, h_A, &N, h_R, &N );
if (opts.ngpu == 1) {
//printf("calling dsyevdx_2stage 1 GPU\n");
magma_dsyevdx_2stage(opts.jobz, range, opts.uplo, N,
h_R, N,
vl, vu, il, iu,
&m1, w1,
h_work, lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, lrwork,
#endif
iwork, liwork,
&info);
} else {
//printf("calling dsyevdx_2stage_m %d GPU\n", (int) opts.ngpu);
magma_dsyevdx_2stage_m(opts.ngpu, opts.jobz, range, opts.uplo, N,
h_R, N,
vl, vu, il, iu,
&m1, w1,
h_work, lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, lrwork,
#endif
iwork, liwork,
&info);
}
}
// ===================================================================
// Performs operation using MAGMA
// ===================================================================
lapackf77_dlacpy( MagmaUpperLowerStr, &N, &N, h_A, &N, h_R, &N );
gpu_time = magma_wtime();
if (opts.ngpu == 1) {
//printf("calling dsyevdx_2stage 1 GPU\n");
magma_dsyevdx_2stage(opts.jobz, range, opts.uplo, N,
h_R, N,
vl, vu, il, iu,
&m1, w1,
h_work, lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, lrwork,
#endif
iwork, liwork,
&info);
} else {
//printf("calling dsyevdx_2stage_m %d GPU\n", (int) opts.ngpu);
magma_dsyevdx_2stage_m(opts.ngpu, opts.jobz, range, opts.uplo, N,
h_R, N,
vl, vu, il, iu,
&m1, w1,
h_work, lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, lrwork,
#endif
iwork, liwork,
&info);
}
gpu_time = magma_wtime() - gpu_time;
printf("%5d %5d %7.2f ",
(int) N, (int) m1, gpu_time );
if ( opts.check ) {
double eps = lapackf77_dlamch("E");
//printf("\n");
//printf("------ TESTS FOR MAGMA DSYEVD ROUTINE ------- \n");
//printf(" Size of the Matrix %d by %d\n", (int) N, (int) N);
//printf("\n");
//printf(" The matrix A is randomly generated for each test.\n");
//printf("============\n");
//printf(" The relative machine precision (eps) is %8.2e\n",eps);
//printf(" Computational tests pass if scaled residuals are less than 60.\n");
/* Check the orthogonality, reduction and the eigen solutions */
if (opts.jobz == MagmaVec) {
info_ortho = check_orthogonality(N, N, h_R, N, eps);
info_reduction = check_reduction(opts.uplo, N, 1, h_A, w1, N, h_R, eps);
}
//printf("------ CALLING LAPACK DSYEVD TO COMPUTE only eigenvalue and verify elementswise ------- \n");
lapackf77_dsyevd("N", "L", &N,
h_A, &N, w2,
h_work, &lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, &lrwork,
#endif
iwork, &liwork,
&info);
info_solution = check_solution(N, w2, w1, eps);
if ( (info_solution == 0) && (info_ortho == 0) && (info_reduction == 0) ) {
printf(" ok\n");
//printf("***************************************************\n");
//printf(" ---- TESTING DSYEVD ...................... PASSED !\n");
//printf("***************************************************\n");
}
else {
printf(" failed\n");
status += 1;
//printf("************************************************\n");
//printf(" - TESTING DSYEVD ... FAILED !\n");
//printf("************************************************\n");
}
}
TESTING_FREE_CPU( h_A );
TESTING_FREE_CPU( w1 );
TESTING_FREE_CPU( w2 );
TESTING_FREE_CPU( iwork );
TESTING_FREE_PIN( h_R );
TESTING_FREE_PIN( h_work );
#if defined(PRECISION_z) || defined(PRECISION_c)
TESTING_FREE_PIN( rwork );
#endif
fflush( stdout );
}
if ( opts.niter > 1 ) {
printf( "\n" );
}
}
/* Shutdown */
TESTING_FINALIZE();
return status;
}
/**
Purpose
-------
DSYGVDX_2STAGE computes all the eigenvalues, and optionally, the eigenvectors
of a complex generalized Hermitian-definite eigenproblem, of the form
A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
B are assumed to be Hermitian and B is also positive definite.
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]
itype INTEGER
Specifies the problem type to be solved:
= 1: A*x = (lambda)*B*x
= 2: A*B*x = (lambda)*x
= 3: B*A*x = (lambda)*x
@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]
jobz magma_vec_t
- = MagmaNoVec: Compute eigenvalues only;
- = MagmaVec: Compute eigenvalues and eigenvectors.
@param[in]
uplo magma_uplo_t
- = MagmaUpper: Upper triangles of A and B are stored;
- = MagmaLower: Lower triangles of A and B are stored.
@param[in]
n INTEGER
The order of the matrices A and B. N >= 0.
@param[in,out]
A DOUBLE PRECISION 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.
\n
On exit, if JOBZ = MagmaVec, then if INFO = 0, A contains the
matrix Z of eigenvectors. The eigenvectors are normalized
as follows:
if ITYPE = 1 or 2, Z**H*B*Z = I;
if ITYPE = 3, Z**H*inv(B)*Z = I.
If JOBZ = MagmaNoVec, then on exit the upper triangle (if UPLO=MagmaUpper)
or the lower triangle (if UPLO=MagmaLower) of A, including the
diagonal, is destroyed.
@param[in]
lda INTEGER
The leading dimension of the array A. LDA >= max(1,N).
@param[in,out]
B DOUBLE PRECISION array, dimension (LDB, N)
On entry, the Hermitian matrix B. If UPLO = MagmaUpper, the
leading N-by-N upper triangular part of B contains the
upper triangular part of the matrix B. If UPLO = MagmaLower,
the leading N-by-N lower triangular part of B contains
the lower triangular part of the matrix B.
\n
On exit, if INFO <= N, the part of B containing the matrix is
overwritten by the triangular factor U or L from the Cholesky
factorization B = U**H*U or B = L*L**H.
@param[in]
ldb INTEGER
The leading dimension of the array B. LDB >= 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 eigenvalues in ascending order.
@param[out]
work (workspace) DOUBLE PRECISION 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 + 2*N + N*NB.
If JOBZ = MagmaVec 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.
\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]
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: ZPOTRF or ZHEEVD returned an error code:
<= N: 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);
> N: if INFO = N + i, for 1 <= i <= N, then the leading
minor of order i of B is not positive definite.
The factorization of B could not be completed and
no eigenvalues or eigenvectors were computed.
Further Details
---------------
Based on contributions by
Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
Modified so that no backsubstitution is performed if ZHEEVD fails to
converge (NEIG in old code could be greater than N causing out of
bounds reference to A - reported by Ralf Meyer). Also corrected the
description of INFO and the test on ITYPE. Sven, 16 Feb 05.
@ingroup magma_dsygv_driver
********************************************************************/
extern "C" magma_int_t
magma_dsygvdx_2stage_m(magma_int_t nrgpu, magma_int_t itype, magma_vec_t jobz, magma_range_t range, magma_uplo_t uplo, magma_int_t n,
double *A, magma_int_t lda, double *B, magma_int_t ldb,
double vl, double vu, magma_int_t il, magma_int_t iu,
magma_int_t *m, double *w, double *work, magma_int_t lwork,
magma_int_t *iwork, magma_int_t liwork, magma_int_t *info)
{
const char* uplo_ = lapack_uplo_const( uplo );
const char* jobz_ = lapack_vec_const( jobz );
double d_one = MAGMA_D_ONE;
magma_int_t lower;
magma_trans_t trans;
magma_int_t wantz;
magma_int_t lquery;
magma_int_t alleig, valeig, indeig;
magma_int_t lwmin;
magma_int_t liwmin;
/* 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 || liwork == -1);
*info = 0;
if (itype < 1 || itype > 3) {
*info = -1;
} else if (! (alleig || valeig || indeig)) {
*info = -2;
} else if (! (wantz || (jobz == MagmaNoVec))) {
*info = -3;
} else if (! (lower || (uplo == MagmaUpper))) {
*info = -4;
} else if (n < 0) {
*info = -5;
} else if (lda < max(1,n)) {
*info = -7;
} else if (ldb < max(1,n)) {
*info = -9;
} else {
if (valeig) {
if (n > 0 && vu <= vl) {
*info = -11;
}
} else if (indeig) {
if (il < 1 || il > max(1,n)) {
*info = -12;
} else if (iu < min(n,il) || iu > n) {
*info = -13;
}
}
}
magma_int_t nb = magma_get_dbulge_nb(n, parallel_threads);
magma_int_t lq2 = magma_dbulge_get_lq2(n, parallel_threads);
if (wantz) {
lwmin = lq2 + 1 + 6*n + 2*n*n;
liwmin = 3 + 5*n;
} else {
lwmin = 2*n + n*nb;
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] = lwmin * one_eps;
iwork[0] = liwmin;
if (lwork < lwmin && ! lquery) {
*info = -17;
} else if (liwork < liwmin && ! lquery) {
*info = -19;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info));
return *info;
} else if (lquery) {
return *info;
}
/* Quick return if possible */
if (n == 0) {
return *info;
}
/* Check if matrix is very small then just call LAPACK on CPU, no need for GPU */
if (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_dsygvd(&itype, jobz_, uplo_,
&n, A, &lda, B, &ldb,
w, work, &lwork,
iwork, &liwork, info);
*m = n;
return *info;
}
/* Form A Cholesky factorization of B. */
magma_timer_t time=0;
timer_start( time );
magma_dpotrf_m(nrgpu, uplo, n, B, ldb, info);
if (*info != 0) {
*info = n + *info;
return *info;
}
timer_stop( time );
timer_printf( "time dpotrf_m = %6.2f\n", time );
timer_start( time );
/* Transform problem to standard eigenvalue problem and solve. */
magma_dsygst_m(nrgpu, itype, uplo, n, A, lda, B, ldb, info);
timer_stop( time );
timer_printf( "time dsygst_m = %6.2f\n", time );
timer_start( time );
magma_dsyevdx_2stage_m(nrgpu, jobz, range, uplo, n, A, lda, vl, vu, il, iu, m, w, work, lwork, iwork, liwork, info);
timer_stop( time );
timer_printf( "time dsyevdx_2stage_m = %6.2f\n", time );
if (wantz && *info == 0) {
timer_start( time );
/* Backtransform eigenvectors to the original problem. */
if (itype == 1 || itype == 2) {
/* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
backtransform eigenvectors: x = inv(L)'*y or inv(U)*y */
if (lower) {
trans = MagmaTrans;
} else {
trans = MagmaNoTrans;
}
magma_dtrsm_m(nrgpu, MagmaLeft, uplo, trans, MagmaNonUnit, n, *m, d_one, B, ldb, A, lda);
}
else if (itype == 3) {
/* For B*A*x=(lambda)*x;
backtransform eigenvectors: x = L*y or U'*y */
if (lower) {
trans = MagmaNoTrans;
} else {
trans = MagmaTrans;
}
//magma_dtrmm_m(nrgpu, MagmaLeft, uplo, trans, MagmaNonUnit, n, *m, d_one, B, ldb, A, lda);
printf("--- the multi GPU version is falling back to 1 GPU to perform the last TRMM since there is no TRMM_mgpu --- \n");
double *dA=NULL, *dB=NULL;
magma_int_t ldda = n;
magma_int_t lddb = n;
if (MAGMA_SUCCESS != magma_dmalloc( &dB, n*lddb ) ) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
if (MAGMA_SUCCESS != magma_dmalloc( &dA, n*ldda ) ) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
magma_dsetmatrix( n, n, B, ldb, dB, lddb );
magma_dsetmatrix( n, n, A, lda, dA, ldda );
magma_dtrmm(MagmaLeft, uplo, trans, MagmaNonUnit,
n, n, d_one, dB, lddb, dA, ldda);
magma_dgetmatrix( n, n, dA, ldda, A, lda ); }
timer_stop( time );
timer_printf( "time dtrsm/mm + getmatrix = %6.2f\n", time );
}
work[0] = lwmin * one_eps;
iwork[0] = liwmin;
return *info;
} /* magma_dsygvdx_2stage_m */
/* ////////////////////////////////////////////////////////////////////////////
-- Testing chetrd_he2hb
*/
int main( int argc, char** argv)
{
TESTING_INIT_MGPU();
real_Double_t gpu_time, gpu_perf, gflops;
magmaFloatComplex *h_A, *h_R, *h_work, *dT1;
magmaFloatComplex *tau;
float *D, *E;
/* Matrix size */
magma_int_t N, n2, lda, lwork, ldt, lwork0;
magma_int_t info;
magma_int_t ione = 1;
magma_int_t ISEED[4] = {0,0,0,1};
#if defined(CHECKEIG)
#if defined(PRECISION_z) || defined(PRECISION_d)
magma_int_t WANTZ=0;
magma_int_t THREADS=1;
#endif
#endif
magma_int_t NE = 0;
magma_int_t NB = 0;
magma_int_t ngpu = 1;
magma_opts opts;
parse_opts( argc, argv, &opts );
NB = opts.nb;
if (NB < 1)
NB = 64; //64; //magma_get_chetrd_he2hb_nb(N);
// what is NE ?
if (NE < 1)
NE = 64; //N; //magma_get_chetrd_he2hb_nb(N); // N not yet initialized
printf(" N GPU GFlop/s \n");
printf("=====================\n");
for( int itest = 0; itest < opts.ntest; ++itest ) {
for( int iter = 0; iter < opts.niter; ++iter ) {
N = opts.nsize[itest];
lda = N;
ldt = N;
n2 = N*lda;
gflops = FLOPS_CHETRD( N ) / 1e9;
/* We suppose the magma NB is bigger than lapack NB */
lwork0 = N*NB;
/* Allocate host memory for the matrix */
TESTING_MALLOC_CPU( h_A, magmaFloatComplex, lda*N );
TESTING_MALLOC_CPU( tau, magmaFloatComplex, N-1 );
TESTING_MALLOC_PIN( h_R, magmaFloatComplex, lda*N );
TESTING_MALLOC_PIN( h_work, magmaFloatComplex, lwork0 );
TESTING_MALLOC_PIN( D, float, N );
TESTING_MALLOC_PIN( E, float, N );
//TESTING_MALLOC_DEV( dT1, magmaFloatComplex, (2*min(N,N)+(N+31)/32*32)*NB );
TESTING_MALLOC_DEV( dT1, magmaFloatComplex, (N*NB) );
// if (WANTZ) gflops = 2.0*gflops;
/* ====================================================================
Initialize the matrix
=================================================================== */
lapackf77_clarnv( &ione, ISEED, &n2, h_A );
magma_cmake_hermitian( N, h_A, lda );
lapackf77_clacpy( MagmaUpperLowerStr, &N, &N, h_A, &lda, h_R, &lda );
/* ====================================================================
Performs operation using MAGMA
=================================================================== */
magma_device_t cdev;
magma_getdevice( &cdev );
gpu_time = magma_wtime();
/*
magma_chetrd_he2hb( opts.uplo, N, NB, h_R, lda, tau, h_work, lwork0, dT1, THREADS, &info);
tband = magma_wtime - gpu_time();
printf(" Finish BAND N %d NB %d ngpu %d timing= %f\n", N, NB, ngpu, tband);
magma_chetrd_bhe2trc_v5(THREADS, WANTZ, opts.uplo, NE, N, NB, h_R, lda, D, E, dT1, ldt);
*/
/*
magma_chetrd_he2hb( opts.uplo, N, NB, h_R, lda, tau, h_work, lwork, dT1, THREADS, &info);
tband = magma_wtime - gpu_time();
printf(" Finish BAND N %d NB %d ngpu %d timing= %f\n", N, NB, ngpu, tband);
magma_chetrd_bhe2trc(THREADS, WANTZ, opts.uplo, NE, N, NB, h_R, lda, D, E, dT1, ldt);
*/
magma_range_t range = MagmaRangeAll;
magma_int_t fraction_ev = 100;
magma_int_t il, iu, m1;
float vl=0., vu=0.;
if (fraction_ev == 0) {
il = N / 10;
iu = N / 5+il;
}
else {
il = 1;
iu = (int)(fraction_ev*N);
if (iu < 1) iu = 1;
}
magmaFloatComplex *hh_work;
magma_int_t *iwork;
magma_int_t nb, /*lwork,*/ liwork;
magma_int_t threads = magma_get_parallel_numthreads();
#if defined(PRECISION_z) || defined(PRECISION_c)
float *rwork;
magma_int_t lrwork;
lwork = magma_cbulge_get_lq2(N, threads) + 2*N + N*N;
lrwork = 1 + 5*N +2*N*N;
TESTING_MALLOC_PIN( rwork, float, lrwork );
#else
lwork = magma_cbulge_get_lq2(N, threads) + 1 + 6*N + 2*N*N;
#endif
liwork = 3 + 5*N;
nb = magma_get_chetrd_nb(N);
TESTING_MALLOC_PIN( hh_work, magmaFloatComplex, lwork );
TESTING_MALLOC_CPU( iwork, magma_int_t, liwork );
if (ngpu == 1) {
printf("calling cheevdx_2stage 1 GPU\n");
magma_cheevdx_2stage( opts.jobz, range, opts.uplo, N,
h_R, lda,
vl, vu, il, iu,
&m1, D,
hh_work, lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, lrwork,
#endif
iwork, liwork,
&info);
} else {
printf("calling cheevdx_2stage_m %d GPU\n", (int) ngpu);
magma_cheevdx_2stage_m(ngpu, opts.jobz, range, opts.uplo, N,
h_R, lda,
vl, vu, il, iu,
&m1, D,
hh_work, lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, lrwork,
#endif
iwork, liwork,
&info);
}
magma_setdevice( cdev );
gpu_time = magma_wtime() - gpu_time;
gpu_perf = gflops / gpu_time;
/* =====================================================================
Check the factorization
=================================================================== */
/*
if ( opts.check ) {
FILE *fp ;
printf("Writing input matrix in matlab_i_mat.txt ...\n");
fp = fopen ("matlab_i_mat.txt", "w") ;
if ( fp == NULL ) { printf("Couldn't open output file\n"); exit(1); }
for (j=0; j < N; j++) {
for (k=0; k < N; k++) {
#if defined(PRECISION_z) || defined(PRECISION_c)
fprintf(fp, "%5d %5d %11.8f %11.8f\n", k+1, j+1,
h_A[k+j*lda].x, h_A[k+j*lda].y);
#else
fprintf(fp, "%5d %5d %11.8f\n", k+1, j+1, h_A[k+j*lda]);
#endif
}
}
fclose( fp ) ;
printf("Writing output matrix in matlab_o_mat.txt ...\n");
fp = fopen ("matlab_o_mat.txt", "w") ;
if ( fp == NULL ) { printf("Couldn't open output file\n"); exit(1); }
for (j=0; j < N; j++) {
for (k=0; k < N; k++) {
#if defined(PRECISION_z) || defined(PRECISION_c)
fprintf(fp, "%5d %5d %11.8f %11.8f\n", k+1, j+1,
h_R[k+j*lda].x, h_R[k+j*lda].y);
#else
fprintf(fp, "%5d %5d %11.8f\n", k+1, j+1, h_R[k+j*lda]);
#endif
}
}
fclose( fp ) ;
}
*/
/* =====================================================================
Print performance and error.
=================================================================== */
#if defined(CHECKEIG)
#if defined(PRECISION_z) || defined(PRECISION_d)
if ( opts.check ) {
printf(" Total N %5d gflops %6.2f timing %6.2f seconds\n", (int) N, gpu_perf, gpu_time );
char JOBZ;
if (WANTZ == 0)
JOBZ = 'N';
else
JOBZ = 'V';
float nrmI=0.0, nrm1=0.0, nrm2=0.0;
int lwork2 = 256*N;
magmaFloatComplex *work2, *AINIT;
float *rwork2, *D2;
// TODO free this memory !
magma_cmalloc_cpu( &work2, lwork2 );
magma_smalloc_cpu( &rwork2, N );
magma_smalloc_cpu( &D2, N );
magma_cmalloc_cpu( &AINIT, N*lda );
memcpy(AINIT, h_A, N*lda*sizeof(magmaFloatComplex));
/* compute the eigenvalues using lapack routine to be able to compare to it and used as ref */
cpu_time = magma_wtime();
i= min(12, THREADS);
#if defined(USEMKL)
mkl_set_num_threads( i );
#endif
#if defined(USEACML)
omp_set_num_threads(i);
#endif
lapackf77_cheev( "N", "L", &N, h_A, &lda, D2, work2, &lwork2,
#if defined(PRECISION_z) || defined (PRECISION_c)
rwork2,
#endif
&info );
///* call eigensolver for our resulting tridiag [D E] and for Q */
//dstedc_withZ('V', N, D, E, h_R, lda);
////ssterf_( &N, D, E, &info);
////
cpu_time = magma_wtime() - cpu_time;
printf(" Finish CHECK - EIGEN timing= %f threads %d\n", cpu_time, i);
/*
for (i=0; i < 10; i++)
printf(" voici lpk D[%d] %8.2e\n", i, D2[i]);
*/
//magmaFloatComplex mydz=0.0, mydo=1.0;
//magmaFloatComplex *Z;
// magma_cmalloc_cpu( &Z, N*lda );
// dgemm_("N", "N", &N, &N, &N, &mydo, h_R, &lda, h_A, &lda, &mydz, Z, &lda);
/* compare result */
cmp_vals(N, D2, D, &nrmI, &nrm1, &nrm2);
magmaFloatComplex *WORKAJETER;
float *RWORKAJETER, *RESU;
// TODO free this memory !
magma_cmalloc_cpu( &WORKAJETER, (2* N * N + N) );
magma_smalloc_cpu( &RWORKAJETER, N );
magma_smalloc_cpu( &RESU, 10 );
int MATYPE;
memset(RESU, 0, 10*sizeof(float));
MATYPE=3;
float NOTHING=0.0;
cpu_time = magma_wtime();
// check results
ccheck_eig_(&JOBZ, &MATYPE, &N, &NB, AINIT, &lda, &NOTHING, &NOTHING, D2, D, h_R, &lda, WORKAJETER, RWORKAJETER, RESU );
cpu_time = magma_wtime() - cpu_time;
printf(" Finish CHECK - results timing= %f\n", cpu_time);
#if defined(USEMKL)
mkl_set_num_threads( 1 );
#endif
#if defined(USEACML)
omp_set_num_threads(1);
#endif
printf("\n");
printf(" ================================================================================================================\n");
printf(" ==> INFO voici threads=%d N=%d NB=%d WANTZ=%d\n", (int) THREADS, (int) N, (int) NB, (int) WANTZ);
printf(" ================================================================================================================\n");
printf(" DSBTRD : %15s \n", "STATblgv9withQ ");
printf(" ================================================================================================================\n");
if (WANTZ > 0)
printf(" | A - U S U' | / ( |A| n ulp ) : %15.3E \n", RESU[0]);
if (WANTZ > 0)
printf(" | I - U U' | / ( n ulp ) : %15.3E \n", RESU[1]);
printf(" | D1 - EVEIGS | / (|D| ulp) : %15.3E \n", RESU[2]);
printf(" max | D1 - EVEIGS | : %15.3E \n", RESU[6]);
printf(" ================================================================================================================\n\n\n");
printf(" ****************************************************************************************************************\n");
printf(" * Hello here are the norm Infinite (max)=%8.2e norm one (sum)=%8.2e norm2(sqrt)=%8.2e *\n", nrmI, nrm1, nrm2);
printf(" ****************************************************************************************************************\n\n");
}
#endif
#endif
printf(" Total N %5d gflops %6.2f timing %6.2f seconds\n", (int) N, gpu_perf, gpu_time );
printf("============================================================================\n\n\n");
/* Memory clean up */
TESTING_FREE_CPU( h_A );
TESTING_FREE_CPU( tau );
TESTING_FREE_PIN( h_R );
TESTING_FREE_PIN( h_work );
TESTING_FREE_PIN( D );
TESTING_FREE_PIN( E );
TESTING_FREE_DEV( dT1 );
/* TODO - not all memory has been freed inside loop */
fflush( stdout );
}
if ( opts.niter > 1 ) {
printf( "\n" );
}
}
TESTING_FINALIZE_MGPU();
return EXIT_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
-------
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) DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION dimension(BLKCNT, VBLKSIZ)
???
@param[in]
wantz INTEGER
if COMPT = 0 T is not computed
if COMPT = 1 T is computed
@param[out]
T DOUBLE PRECISION 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_dsyev_2stage
********************************************************************/
extern "C" magma_int_t
magma_dsytrd_sb2st(
magma_uplo_t uplo, magma_int_t n, magma_int_t nb, magma_int_t Vblksiz,
double *A, magma_int_t lda, double *d, double *e,
double *V, magma_int_t ldv, double *TAU,
magma_int_t wantz, double *T, magma_int_t ldt)
{
#ifdef ENABLE_TIMER
real_Double_t timeblg=0.0;
#endif
magma_int_t parallel_threads = magma_get_parallel_numthreads();
magma_int_t mklth = magma_get_lapack_numthreads();
magma_int_t ompth = magma_get_omp_numthreads();
//magma_set_omp_numthreads(1);
//magma_set_lapack_numthreads(1);
magma_int_t blkcnt, sizTAU2, sizT2, sizV2;
magma_dbulge_getstg2size(n, nb, wantz,
Vblksiz, ldv, ldt, &blkcnt,
&sizTAU2, &sizT2, &sizV2);
memset(T, 0, sizT2*sizeof(double));
memset(TAU, 0, sizTAU2*sizeof(double));
memset(V, 0, sizV2*sizeof(double));
magma_int_t INgrsiz=1;
magma_int_t nbtiles = magma_ceildiv(n, nb);
volatile magma_int_t* prog;
magma_malloc_cpu((void**) &prog, (2*nbtiles+parallel_threads+10)*sizeof(magma_int_t));
memset((void *) prog, 0, (2*nbtiles+parallel_threads+10)*sizeof(magma_int_t));
magma_dbulge_id_data* arg;
magma_malloc_cpu((void**) &arg, parallel_threads*sizeof(magma_dbulge_id_data));
pthread_t* thread_id;
magma_malloc_cpu((void**) &thread_id, parallel_threads*sizeof(pthread_t));
pthread_attr_t thread_attr;
magma_dbulge_data data_bulge;
magma_dbulge_data_init(&data_bulge, parallel_threads, n, nb, nbtiles, INgrsiz, Vblksiz, wantz,
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(parallel_threads);
//timing
#ifdef ENABLE_TIMER
timeblg = magma_wtime();
#endif
// Launch threads
for (magma_int_t thread = 1; thread < parallel_threads; thread++) {
magma_dbulge_id_data_init(&(arg[thread]), thread, &data_bulge);
pthread_create(&thread_id[thread], &thread_attr, magma_dsytrd_sb2st_parallel_section, &arg[thread]);
}
magma_dbulge_id_data_init(&(arg[0]), 0, &data_bulge);
magma_dsytrd_sb2st_parallel_section(&arg[0]);
// Wait for completion
for (magma_int_t thread = 1; thread < parallel_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((void *) prog);
magma_dbulge_data_destroy(&data_bulge);
magma_set_omp_numthreads(ompth);
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 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 DLARFG 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.
* */
#ifdef COMPLEX
if (uplo == MagmaLower) {
for (magma_int_t i=0; i < n-1; i++) {
d[i] = MAGMA_D_REAL( A[i*lda ] );
e[i] = MAGMA_D_REAL( A[i*lda+1] );
}
d[n-1] = MAGMA_D_REAL(A[(n-1)*lda]);
} else { /* MagmaUpper not tested yet */
for (magma_int_t i=0; i < n-1; i++) {
d[i] = MAGMA_D_REAL( A[i*lda+nb] );
e[i] = MAGMA_D_REAL( A[i*lda+nb-1] );
}
d[n-1] = MAGMA_D_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
-------
ZHEGVDX_2STAGE computes all the eigenvalues, and optionally, the eigenvectors
of a complex generalized Hermitian-definite eigenproblem, of the form
A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
B are assumed to be Hermitian and B is also positive definite.
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]
itype INTEGER
Specifies the problem type to be solved:
= 1: A*x = (lambda)*B*x
= 2: A*B*x = (lambda)*x
= 3: B*A*x = (lambda)*x
@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 triangles of A and B are stored;
- = MagmaLower: Lower triangles of A and B are stored.
@param[in]
n INTEGER
The order of the matrices A and B. 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.
\n
On exit, if JOBZ = MagmaVec, then if INFO = 0, A contains the
matrix Z of eigenvectors. The eigenvectors are normalized
as follows:
if ITYPE = 1 or 2, Z**H*B*Z = I;
if ITYPE = 3, Z**H*inv(B)*Z = I.
If JOBZ = MagmaNoVec, then on exit the upper triangle (if UPLO=MagmaUpper)
or the lower triangle (if UPLO=MagmaLower) of A, including the
diagonal, is destroyed.
@param[in]
lda INTEGER
The leading dimension of the array A. LDA >= max(1,N).
@param[in,out]
B COMPLEX_16 array, dimension (LDB, N)
On entry, the Hermitian matrix B. If UPLO = MagmaUpper, the
leading N-by-N upper triangular part of B contains the
upper triangular part of the matrix B. If UPLO = MagmaLower,
the leading N-by-N lower triangular part of B contains
the lower triangular part of the matrix B.
\n
On exit, if INFO <= N, the part of B containing the matrix is
overwritten by the triangular factor U or L from the Cholesky
factorization B = U**H*U or B = L*L**H.
@param[in]
ldb INTEGER
The leading dimension of the array B. LDB >= 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 eigenvalues in ascending order.
@param[out]
work (workspace) COMPLEX_16 array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK(1) 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 * (NB + 1).
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 (MAX(1,LRWORK))
On exit, if INFO = 0, RWORK(1) 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(1) 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: ZPOTRF or ZHEEVD returned an error code:
<= N: 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);
> N: if INFO = N + i, for 1 <= i <= N, then the leading
minor of order i of B is not positive definite.
The factorization of B could not be completed and
no eigenvalues or eigenvectors were computed.
Further Details
---------------
Based on contributions by
Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
Modified so that no backsubstitution is performed if ZHEEVD fails to
converge (NEIG in old code could be greater than N causing out of
bounds reference to A - reported by Ralf Meyer). Also corrected the
description of INFO and the test on ITYPE. Sven, 16 Feb 05.
@ingroup magma_zhegv_driver
********************************************************************/
extern "C" magma_int_t
magma_zhegvdx_2stage(magma_int_t itype, magma_vec_t jobz, magma_range_t range, magma_uplo_t uplo, magma_int_t n,
magmaDoubleComplex *A, magma_int_t lda,
magmaDoubleComplex *B, magma_int_t ldb,
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)
{
const char* uplo_ = lapack_uplo_const( uplo );
const char* jobz_ = lapack_vec_const( jobz );
magmaDoubleComplex c_one = MAGMA_Z_ONE;
magmaDoubleComplex *dA;
magmaDoubleComplex *dB;
magma_int_t ldda = n;
magma_int_t lddb = n;
magma_int_t lower;
magma_trans_t trans;
magma_int_t wantz;
magma_int_t lquery;
magma_int_t alleig, valeig, indeig;
magma_int_t lwmin;
magma_int_t liwmin;
magma_int_t lrwmin;
magma_queue_t stream;
magma_queue_create( &stream );
/* 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 (itype < 1 || itype > 3) {
*info = -1;
} else if (! (alleig || valeig || indeig)) {
*info = -2;
} else if (! (wantz || (jobz == MagmaNoVec))) {
*info = -3;
} else if (! (lower || (uplo == MagmaUpper))) {
*info = -4;
} else if (n < 0) {
*info = -5;
} else if (lda < max(1,n)) {
*info = -7;
} else if (ldb < max(1,n)) {
*info = -9;
} else {
if (valeig) {
if (n > 0 && vu <= vl) {
*info = -11;
}
} else if (indeig) {
if (il < 1 || il > max(1,n)) {
*info = -12;
} else if (iu < min(n,il) || iu > n) {
*info = -13;
}
}
}
magma_int_t nb = magma_get_zbulge_nb(n, parallel_threads);
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 * (nb + 1);
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 = -17;
} else if (lrwork < lrwmin && ! lquery) {
*info = -19;
} else if (liwork < liwmin && ! lquery) {
*info = -21;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info));
return *info;
} else if (lquery) {
return *info;
}
/* Quick return if possible */
if (n == 0) {
return *info;
}
/* Check if matrix is very small then just call LAPACK on CPU, no need for GPU */
if (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_zhegvd(&itype, jobz_, uplo_,
&n, A, &lda, B, &ldb,
w, work, &lwork,
#if defined(PRECISION_z) || defined(PRECISION_c)
rwork, &lrwork,
#endif
iwork, &liwork, info);
*m = n;
return *info;
}
// TODO: fix memory leak
if (MAGMA_SUCCESS != magma_zmalloc( &dA, n*ldda ) ||
MAGMA_SUCCESS != magma_zmalloc( &dB, n*lddb )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
/* Form a Cholesky factorization of B. */
magma_zsetmatrix( n, n, B, ldb, dB, lddb );
magma_zsetmatrix_async( n, n,
A, lda,
dA, ldda, stream );
magma_timer_t time=0;
timer_start( time );
magma_zpotrf_gpu(uplo, n, dB, lddb, info);
if (*info != 0) {
*info = n + *info;
return *info;
}
timer_stop( time );
timer_printf( "time zpotrf_gpu = %6.2f\n", time );
magma_queue_sync( stream );
magma_zgetmatrix_async( n, n,
dB, lddb,
B, ldb, stream );
/* Transform problem to standard eigenvalue problem and solve. */
timer_start( time );
magma_zhegst_gpu(itype, uplo, n, dA, ldda, dB, lddb, info);
timer_stop( time );
timer_printf( "time zhegst_gpu = %6.2f\n", time );
magma_zgetmatrix( n, n, dA, ldda, A, lda );
magma_queue_sync( stream );
magma_free( dA );
magma_free( dB );
timer_start( time );
magma_zheevdx_2stage(jobz, range, uplo, n, A, lda, vl, vu, il, iu, m, w, work, lwork, rwork, lrwork, iwork, liwork, info);
timer_stop( time );
timer_printf( "time zheevdx_2stage = %6.2f\n", time );
if (wantz && *info == 0) {
// TODO fix memory leak
if (MAGMA_SUCCESS != magma_zmalloc( &dA, n*ldda ) ||
MAGMA_SUCCESS != magma_zmalloc( &dB, n*lddb )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
timer_start( time );
magma_zsetmatrix( n, *m, A, lda, dA, ldda );
magma_zsetmatrix( n, n, B, ldb, dB, lddb );
/* Backtransform eigenvectors to the original problem. */
if (itype == 1 || itype == 2) {
/* For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
backtransform eigenvectors: x = inv(L)'*y or inv(U)*y */
if (lower) {
trans = MagmaConjTrans;
} else {
trans = MagmaNoTrans;
}
magma_ztrsm(MagmaLeft, uplo, trans, MagmaNonUnit, n, *m, c_one, dB, lddb, dA, ldda);
}
else if (itype == 3) {
/* For B*A*x=(lambda)*x;
backtransform eigenvectors: x = L*y or U'*y */
if (lower) {
trans = MagmaNoTrans;
} else {
trans = MagmaConjTrans;
}
magma_ztrmm(MagmaLeft, uplo, trans, MagmaNonUnit, n, *m, c_one, dB, lddb, dA, ldda);
}
magma_zgetmatrix( n, *m, dA, ldda, A, lda );
timer_stop( time );
timer_printf( "time trsm/mm + getmatrix = %6.2f\n", time );
magma_free( dA );
magma_free( dB );
}
magma_queue_destroy( stream );
work[0] = MAGMA_Z_MAKE( lwmin * one_eps, 0.); // round up
rwork[0] = lrwmin * one_eps;
iwork[0] = liwmin;
return *info;
} /* magma_zhegvdx_2stage */
void test_num_threads()
{
printf( "%%=====================================================================\n%s\n", __func__ );
// test that getting & setting numthreads works
magma_int_t p_nthread_orig = magma_get_parallel_numthreads();
magma_int_t l_nthread_orig = magma_get_lapack_numthreads();
printf( "get; parallel_numthread=%2d, lapack_numthread=%2d\n",
p_nthread_orig, l_nthread_orig );
magma_set_lapack_numthreads( 4 );
magma_int_t p_nthread = magma_get_parallel_numthreads();
magma_int_t l_nthread = magma_get_lapack_numthreads();
printf( "set( 4); parallel_numthread=%2d, lapack_numthread=%2d (expect 4)\n",
p_nthread, l_nthread );
warn( p_nthread == p_nthread_orig );
warn( l_nthread == 4 );
magma_set_lapack_numthreads( 1 );
p_nthread = magma_get_parallel_numthreads();
l_nthread = magma_get_lapack_numthreads();
printf( "set( 1); parallel_numthread=%2d, lapack_numthread=%2d (expect 1)\n",
p_nthread, l_nthread );
warn( p_nthread == p_nthread_orig );
warn( l_nthread == 1 );
magma_set_lapack_numthreads( 8 );
p_nthread = magma_get_parallel_numthreads();
l_nthread = magma_get_lapack_numthreads();
printf( "set( 8); parallel_numthread=%2d, lapack_numthread=%2d (expect 8)\n",
p_nthread, l_nthread );
warn( p_nthread == p_nthread_orig );
warn( l_nthread == 8 );
magma_set_lapack_numthreads( l_nthread_orig );
p_nthread = magma_get_parallel_numthreads();
l_nthread = magma_get_lapack_numthreads();
printf( "set(%2d); parallel_numthread=%2d, lapack_numthread=%2d (expect %2d)\n",
l_nthread_orig, p_nthread, l_nthread, l_nthread_orig );
warn( p_nthread == p_nthread_orig );
warn( l_nthread == l_nthread_orig );
#ifndef _MSC_VER // not Windows
// test that parsing MAGMA_NUM_THREADS works
// TODO need some way to get ncores. This is circular: assume with huge
// NUM_THREADS that the routine gives the ncores. The user can verify.
setenv("MAGMA_NUM_THREADS", "10000", 1 );
magma_int_t ncores = magma_get_parallel_numthreads();
magma_int_t omp_threads = ncores;
const char* omp_str = getenv("OMP_NUM_THREADS");
if ( omp_str != NULL ) {
omp_threads = atoi( omp_str );
}
printf( "\nusing ncores=%d, omp_num_threads=%d\n\n", ncores, omp_threads );
printf( "$MAGMA_NUM_THREADS nthread expect\n" );
printf( "%%==================================\n" );
unsetenv("MAGMA_NUM_THREADS");
p_nthread = magma_get_parallel_numthreads();
printf( "%-18s %7d %6d (omp_threads)\n\n", "not set", p_nthread, omp_threads );
warn( p_nthread == omp_threads );
setenv("MAGMA_NUM_THREADS", "", 1 );
p_nthread = magma_get_parallel_numthreads();
printf( "%-18s %7d %6d\n\n", getenv("MAGMA_NUM_THREADS"), p_nthread, 1 );
warn( p_nthread == 1 );
setenv("MAGMA_NUM_THREADS", "-1", 1 );
p_nthread = magma_get_parallel_numthreads();
printf( "%-18s %7d %6d\n\n", getenv("MAGMA_NUM_THREADS"), p_nthread, 1 );
warn( p_nthread == 1 );
setenv("MAGMA_NUM_THREADS", "2junk", 1 );
p_nthread = magma_get_parallel_numthreads();
printf( "%-18s %7d %6d\n\n", getenv("MAGMA_NUM_THREADS"), p_nthread, 1 );
warn( p_nthread == 1 );
setenv("MAGMA_NUM_THREADS", "0", 1 );
p_nthread = magma_get_parallel_numthreads();
printf( "%-18s %7d %6d\n\n", getenv("MAGMA_NUM_THREADS"), p_nthread, 1 );
warn( p_nthread == 1 );
setenv("MAGMA_NUM_THREADS", "1", 1 );
p_nthread = magma_get_parallel_numthreads();
printf( "%-18s %7d %6d\n\n", getenv("MAGMA_NUM_THREADS"), p_nthread, 1 );
warn( p_nthread == 1 );
setenv("MAGMA_NUM_THREADS", "2", 1 );
p_nthread = magma_get_parallel_numthreads();
printf( "%-18s %7d %6d\n\n", getenv("MAGMA_NUM_THREADS"), p_nthread, 2 );
warn( p_nthread == min( 2, ncores ) );
setenv("MAGMA_NUM_THREADS", "4", 1 );
p_nthread = magma_get_parallel_numthreads();
printf( "%-18s %7d %6d\n\n", getenv("MAGMA_NUM_THREADS"), p_nthread, 4 );
warn( p_nthread == min( 4, ncores ) );
setenv("MAGMA_NUM_THREADS", "8", 1 );
p_nthread = magma_get_parallel_numthreads();
printf( "%-18s %7d %6d\n\n", getenv("MAGMA_NUM_THREADS"), p_nthread, 8 );
warn( p_nthread == min( 8, ncores ) );
setenv("MAGMA_NUM_THREADS", "16", 1 );
p_nthread = magma_get_parallel_numthreads();
printf( "%-18s %7d %6d\n\n", getenv("MAGMA_NUM_THREADS"), p_nthread, 16 );
warn( p_nthread == min( 16, ncores ) );
setenv("MAGMA_NUM_THREADS", "1000", 1 );
p_nthread = magma_get_parallel_numthreads();
printf( "%-18s %7d %6d (ncores)\n\n", getenv("MAGMA_NUM_THREADS"), p_nthread, ncores );
warn( p_nthread == min( 1000, ncores ) );
#endif // not Windows
}
/**
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 */
