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;
}
Esempio n. 4
0
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;
  }
Esempio n. 5
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;
  
}