void GeneralizedEigenSystemSolverRealSymmetricMatrices(const Array2 < doublevar > & Ain, const Array2 < doublevar> & Bin, Array1 < doublevar> & evals, Array2 < doublevar> & evecs){
  //solves generalized eigensystem problem A.x=labda*B.x
  //returns eigenvalues from largest to lowest and
  //eigenvectors, where for i-th eigenvalue, the eigenvector components are evecs(*,i)
  //eigenvectors are normalized such that: evecs**T*B*evecs = I;
#ifdef USE_LAPACK //if LAPACK
  int N=Ain.dim[0];
  
  /* allocate and initialise the matrix */
  Array2 <doublevar> A_temp(N,N), B_temp(N,N);
  Array1 <doublevar>  W,WORK;
  
  
  /* allocate space for the output parameters and workspace arrays */
  W.Resize(N);
  A_temp=Ain;
  B_temp=Bin;
  
  int info;
  int NB=64;
  int NMAX=N;
  int lda=NMAX;
  int ldb=NMAX;
  int LWORK=(NB+2)*NMAX;
  WORK.Resize(LWORK);

  /* get the eigenvalues and eigenvectors */
  info=dsygv(1, 'V', 'U' , N,  A_temp.v,  lda,  B_temp.v, ldb, W.v, WORK.v, LWORK);

  if(info>0)
    error("Internal error in the LAPACK routine dsyevr");
  if(info<0)
    error("Problem with the input parameter of LAPACK routine dsyevr in position "-info);

  for (int i=0; i<N; i++)
    evals(i)=W[N-1-i];

  for (int i=0; i<N; i++) {
    for (int j=0; j<N; j++) {
      evecs(j,i)=A_temp(N-1-i,j);
    }
  }
 //END OF LAPACK 
#else //IF NO LAPACK
  //for now we will solve it only approximatively
   int N=Ain.dim[0];
   Array2 <doublevar> B_inverse(N,N),A_renorm(N,N);
   InvertMatrix(Bin,B_inverse,N);
   MultiplyMatrices(B_inverse,Ain,A_renorm,N);
   //note A_renorm is not explicitly symmetric
   EigenSystemSolverRealSymmetricMatrix(A_renorm,evals,evecs);
#endif //END OF NO LAPACK
}
Ejemplo n.º 2
0
static HYPRE_Int dsygv_interface (HYPRE_Int *itype, char *jobz, char *uplo, HYPRE_Int *
                            n, double *a, HYPRE_Int *lda, double *b, HYPRE_Int *ldb,
                            double *w, double *work, HYPRE_Int *lwork, HYPRE_Int *info)
{
#ifdef HYPRE_USING_ESSL
   dsygv(*itype, a, *lda, b, *ldb, w, a, *lda, *n, work, *lwork );
#else
   hypre_F90_NAME_LAPACK( dsygv, DSYGV )( itype, jobz, uplo, n, 
                                          a, lda, b, ldb,
                                          w, work, lwork, info );
#endif
   return 0;
}