int diagonalize_bisection(localized_matrix<double, MATRIX_MAJOR>& mata, localized_matrix<double, MATRIX_MAJOR>& matb,
double* eigvals,
rokko::parameters const& params, timer& timer) {
rokko::parameters params_out;
char jobz = 'N'; // only eigenvalues
int dim = mata.innerSize();
int lda = mata.outerSize();
int ldb = matb.outerSize();
lapack_int m; // output: found eigenvalues
double abstol;
get_key(params, "abstol", abstol);
if (abstol < 0) {
std::cerr << "Error in diagonalize_bisection" << std::endl
<< "abstol is negative value, which means QR method." << std::endl
<< "To use dsygvx as bisection solver, set abstol a positive value" << std::endl;
throw;
}
if (!params.defined("abstol")) { // default: optimal value for bisection method
abstol = 2 * LAPACKE_dlamch('S');
}
params_out.set("abstol", abstol);
char uplow = get_matrix_part(params);
lapack_int il, iu;
double vl, vu;
char range = get_eigenvalues_range(params, vl, vu, il, iu);
std::vector<lapack_int> ifail(dim);
timer.start(timer_id::diagonalize_diagonalize);
int info;
if(mata.is_col_major())
info = LAPACKE_dsygvx(LAPACK_COL_MAJOR, 1, jobz, range, uplow, dim,
&mata(0,0), lda, &matb(0,0), ldb, vl, vu, il, iu,
abstol, &m, eigvals, NULL, lda, &ifail[0]);
else
info = LAPACKE_dsygvx(LAPACK_ROW_MAJOR, 1, jobz, range, uplow, dim,
&mata(0,0), lda, &matb(0,0), ldb, vl, vu, il, iu,
abstol, &m, eigvals, NULL, lda, &ifail[0]);
timer.stop(timer_id::diagonalize_diagonalize);
timer.start(timer_id::diagonalize_finalize);
if (info) {
std::cerr << "error at dsygvx function. info=" << info << std::endl;
if (info < 0) {
std::cerr << "This means that ";
std::cerr << "the " << abs(info) << "-th argument had an illegal value." << std::endl;
}
exit(1);
}
params_out.set("m", m);
params_out.set("ifail", ifail);
if (params.get_bool("verbose")) {
print_verbose("dsygvx (bisection)", jobz, range, uplow, vl, vu, il, iu, params_out);
}
timer.stop(timer_id::diagonalize_finalize);
return info;
}
int do_memory_uplo(int n, W& workspace ) {
typedef typename bindings::remove_imaginary<T>::type real_type ;
typedef ublas::matrix<T, ublas::column_major> matrix_type ;
typedef ublas::vector<real_type> vector_type ;
typedef ublas::hermitian_adaptor<matrix_type, UPLO> hermitian_type;
// Set matrix
matrix_type a( n, n ); a.clear();
vector_type e1( n );
vector_type e2( n );
fill( a );
matrix_type a2( a );
matrix_type z( a );
// Compute Schur decomposition.
fortran_int_t m;
ublas::vector<fortran_int_t> ifail(n);
hermitian_type h_a( a );
lapack::heevx( 'V', 'A', h_a, real_type(0.0), real_type(1.0), 2, n-1, real_type(1e-28), m,
e1, z, ifail, workspace ) ;
if (check_residual( a2, e1, z )) return 255 ;
hermitian_type h_a2( a2 );
lapack::heevx( 'N', 'A', h_a2, real_type(0.0), real_type(1.0), 2, n-1, real_type(1e-28), m,
e2, z, ifail, workspace ) ;
if (norm_2( e1 - e2 ) > n * norm_2( e1 ) * std::numeric_limits< real_type >::epsilon()) return 255 ;
// Test for a matrix range
fill( a ); a2.assign( a );
typedef ublas::matrix_range< matrix_type > matrix_range ;
typedef ublas::hermitian_adaptor<matrix_range, UPLO> hermitian_range_type;
ublas::range r(1,n-1) ;
matrix_range a_r( a, r, r );
matrix_range z_r( z, r, r );
ublas::vector_range< vector_type> e_r( e1, r );
ublas::vector<fortran_int_t> ifail_r(n-2);
hermitian_range_type h_a_r( a_r );
lapack::heevx( 'V', 'A', h_a_r, real_type(0.0), real_type(1.0), 2, n-1, real_type(1e-28), m,
e_r, z_r, ifail_r, workspace );
matrix_range a2_r( a2, r, r );
if (check_residual( a2_r, e_r, z_r )) return 255 ;
return 0 ;
} // do_memory_uplo()
parameters diagonalize_bisection(localized_matrix<double, MATRIX_MAJOR>& mat, double* eigvals,
localized_matrix<double, MATRIX_MAJOR>& eigvecs,
parameters const& params) {
rokko::parameters params_out;
char jobz = 'V'; // eigenvalues / eigenvectors
int dim = mat.outerSize();
int ldim_mat = mat.innerSize();
int ldim_eigvec = eigvecs.innerSize();
std::vector<lapack_int> ifail(dim);
lapack_int m; // output: found eigenvalues
double abstol;
get_key(params, "abstol", abstol);
if (abstol < 0) {
std::cerr << "Error in diagonalize_bisection" << std::endl
<< "abstol is negative value, which means QR method." << std::endl
<< "To use dsyevx as bisection solver, set abstol a positive value" << std::endl;
throw;
}
if (!params.defined("abstol")) { // default: optimal value for bisection method
abstol = 2 * LAPACKE_dlamch('S');
}
params_out.set("abstol", abstol);
char uplow = get_matrix_part(params);
lapack_int il, iu;
double vl, vu;
char range = get_eigenvalues_range(params, vl, vu, il, iu);
int info;
if(mat.is_col_major())
info = LAPACKE_dsyevx(LAPACK_COL_MAJOR, jobz, range, uplow, dim, &mat(0,0), ldim_mat, vl, vu, il, iu, abstol, &m, eigvals, &eigvecs(0,0), ldim_eigvec, &ifail[0]);
else
info = LAPACKE_dsyevx(LAPACK_ROW_MAJOR, jobz, range, uplow, dim, &mat(0,0), ldim_mat, vl, vu, il, iu, abstol, &m, eigvals, &eigvecs(0,0), ldim_eigvec, &ifail[0]);
if (info) {
std::cerr << "Error at dsyevx function. info=" << info << std::endl;
if (params.get_bool("verbose")) {
std::cerr << "This means that ";
if (info < 0) {
std::cerr << "the " << abs(info) << "-th argument had an illegal value." << std::endl;
} else {
std::cerr << "This means that " << info << " eigenvectors failed to converge." << std::endl;
std::cerr << "The indices of the eigenvectors that failed to converge:" << std::endl;
for (int i=0; i<ifail.size(); ++i) {
if (ifail[i] == 0) break;
std::cerr << ifail[i] << " ";
}
std::cerr << std::endl;
}
}
exit(1);
}
params_out.set("m", m);
params_out.set("ifail", ifail);
if (params.get_bool("verbose")) {
print_verbose("dsyevx (bisecition)", jobz, range, uplow, vl, vu, il, iu, params_out);
}
return params_out;
}
int XC::SymBandEigenSolver::solve(int nModes)
{
if(!theSOE)
{
std::cerr << "SymBandEigenSolver::solve() -- no XC::EigenSOE has been set yet\n";
return -1;
}
// Set number of modes
numModes= nModes;
// Number of equations
int n= theSOE->size;
// Check for quick return
if(numModes < 1)
{
numModes= 0;
return 0;
}
// Simple check
if(numModes > n)
numModes= n;
// Allocate storage for eigenvalues
eigenvalue.resize(n);
// Real work array (see LAPACK dsbevx subroutine documentation)
work.resize(7*n);
// Integer work array (see LAPACK dsbevx subroutine documentation)
std::vector<int> iwork(5*n);
// Leading dimension of eigenvectors
int ldz = n;
// Allocate storage for eigenvectors
eigenvector.resize(ldz*numModes);
// Number of superdiagonals
int kd= theSOE->numSuperD;
// Matrix data
double *ab= theSOE->A.getDataPtr();
// Leading dimension of the matrix
int ldab= kd + 1;
// Leading dimension of q
int ldq= n;
// Orthogonal matrix used in reduction to tridiagonal form
// (see LAPACK dsbevx subroutine documentation)
std::vector<double> q(ldq*n);
// Index ranges [1,numModes] of eigenpairs to compute
int il = 1;
int iu = numModes;
// Compute eigenvalues and eigenvectors
char jobz[] = "V";
// Selected eigenpairs are based on index range [il,iu]
char range[] = "I";
// Upper triagle of matrix is stored
char uplo[] = "U";
// Return value
std::vector<int> ifail(n);
int info= 0;
// Number of eigenvalues returned
int m= 0;
// Not used
double vl = 0.0;
double vu = 1.0;
// Not used ... I think!
double abstol = -1.0;
// if Mass matrix we make modifications to A:
// A -> M^(-1/2) A M^(-1/2)
double *M= theSOE->M.getDataPtr();
double *A= theSOE->A.getDataPtr();
int numSuperD = theSOE->numSuperD;
int size = n;
if(M) //Its seems that the M matrix must be DIAGONAL.
{
int i,j;
bool singular = false;
// form M^(-1/2) and check for singular mass matrix
for(int k=0; k<size; k++)
{
if(M[k] == 0.0)
{
singular = true;
// alternative is to set as a small no ~ 1e-10 times smallest m(i,i) != 0.0
std::cerr << "SymBandEigenSolver::solve() - M matrix singular\n";
return -1;
}
else
{
M[k] = 1.0/sqrt(M[k]);
}
}
// make modifications to A
// Aij -> Mi Aij Mj (based on new_ M)
for(i=0; i<size; i++)
{
double *AijPtr = A +(i+1)*(numSuperD+1) - 1;
int minColRow = i - numSuperD;
if(minColRow < 0) minColRow = 0;
for(j=i; j>=minColRow; j--)
{
*AijPtr *= M[j]*M[i];
AijPtr--;
}
}
}
// Calls the LAPACK routine that computes the eigenvalues and eigenvectors
// of the matrix A previously transforme.
dsbevx_(jobz, range, uplo, &n, &kd, ab, &ldab,
&q[0], &ldq, &vl, &vu, &il, &iu, &abstol, &m,
eigenvalue.getDataPtr(), eigenvector.getDataPtr(), &ldz, work.getDataPtr(), &iwork[0], &ifail[0], &info);
if(info < 0)
{
std::cerr << "SymBandEigenSolver::solve() -- invalid argument number " << -info << " passed to LAPACK dsbevx\n";
return info;
}
if(info > 0)
{
std::cerr << "SymBandEigenSolver::solve() -- LAPACK dsbevx returned error code " << info << std::endl;
return -info;
}
if(m < numModes)
{
std::cerr << "SymBandEigenSolver::solve() -- LAPACK dsbevx only computed " << m << " eigenvalues, " <<
numModes << "were requested\n";
numModes = m;
}
theSOE->factored = true;
// make modifications to the eigenvectors
// Eij -> Mi Eij (based on new_ M)
M= theSOE->M.getDataPtr();
if(M)
{
for(int j=0; j<numModes; j++)
{
double *eigVectJptr = &eigenvector[j*ldz];
double *MPtr = M;
for(int i=0; i<size; i++)
*eigVectJptr++ *= *MPtr++;
}
}
return 0;
}
bool eigen_lapack(int n, vector_t & A, vector_t & S, matrix_t & V)
{
// Use eigenvalue decomposition instead of SVD
// Get only the highest eigen-values, (par::cluster_mds_dim)
int i1 = n - par::cluster_mds_dim + 1;
int i2 = n;
double z = -1;
// Integer workspace size, 5N
vector<int> iwork(5*n,0);
double optim_lwork;
int lwork = -1;
int out_m;
vector_t out_w( par::cluster_mds_dim , 0 );
vector_t out_z( n * par::cluster_mds_dim ,0 );
int ldz = n;
vector<int> ifail(n,0);
int info=0;
double nz = 0;
// Get workspace
dsyevx_("V" , // get eigenvalues and eigenvectors
"I" , // get interval of selected eigenvalues
"L" , // data stored as upper triangular
&n , // order of matrix
&A[0] , // input matrix
&n , // LDA
&nz , // Vlower
&nz , // Vupper
&i1, // from 1st ...
&i2, // ... to nth eigenvalue
&z , // 0 for ABSTOL
&out_m, // # of eigenvalues found
&out_w[0], // first M entries contain sorted eigen-values
&out_z[0], // array (can be mxm? nxn)
&ldz, // make n at first
&optim_lwork, // Get optimal workspace
&lwork, // size of workspace
&iwork[0], // int workspace
&ifail[0], // output: failed to converge
&info );
// Assign workspace
lwork = (int) optim_lwork;
vector_t work( lwork, 0 );
dsyevx_("V" , // get eigenvalues and eigenvectors
"I" , // get interval of selected eigenvalues
"L" , // data stored as upper triangular
&n , // order of matrix
&A[0] , // input matrix
&n , // LDA
&nz , // Vlower
&nz , // Vupper
&i1, // from 1st ...
&i2, // ... to nth eigenvalue
&z , // 0 for ABSTOL
&out_m, // # of eigenvalues found
&out_w[0], // first M entries contain sorted eigen-values
&out_z[0], // array (can be mxm? nxn)
&ldz, // make n at first
&work[0], // Workspace
&lwork, // size of workspace
&iwork[0], // int workspace
&ifail[0], // output: failed to converge
&info );
// Get eigenvalues, vectors
for (int i=0; i< par::cluster_mds_dim; i++)
S[i] = out_w[i];
for (int i=0; i<n; i++)
for (int j=0;j<par::cluster_mds_dim; j++)
V[i][j] = out_z[ i + j*n ];
return true;
}
