dynmatrixev.cc

// -*- tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 2 -*-
// vi: set et ts=4 sw=2 sts=2:
#ifndef DUNE_FMATRIXEIGENVALUES_EXT_CC
#define DUNE_FMATRIXEIGENVALUES_EXT_CC

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif

#include <iostream>
#include <cmath>
#include <cassert>

#include <dune/common/exceptions.hh>

#if HAVE_LAPACK

// nonsymmetric matrices
#define DGEEV_FORTRAN FC_FUNC (dgeev, DGEEV)

// dsyev declaration (in liblapack)
extern "C" {

  /*
   *
   **  purpose
   **  =======
   **
   **  xgeev computes for an N-by-N BASE DATA TYPE nonsymmetric matrix A, the
   **  eigenvalues and, optionally, the left and/or right eigenvectors.
   **
   **  The right eigenvector v(j) of A satisfies
   **                   A * v(j) = lambda(j) * v(j)
   **  where lambda(j) is its eigenvalue.
   **  The left eigenvector u(j) of A satisfies
   **                u(j)**T * A = lambda(j) * u(j)**T
   **  where u(j)**T denotes the transpose of u(j).
   **
   **  The computed eigenvectors are normalized to have Euclidean norm
   **  equal to 1 and largest component real.
   **
   **  arguments
   **  =========
   **
   **  jobvl   (input) char
   **          = 'n': left eigenvectors of a are not computed;
   **          = 'v': left eigenvectors of a are computed.
   **
   **  jobvr   (input) char
   **          = 'n': right eigenvectors of a are not computed;
   **          = 'v': right eigenvectors of a are computed.
   **
   **  n       (input) long int
   **          the order of the matrix v. v >= 0.
   **
   **  a       (input/output) BASE DATA TYPE array, dimension (lda,n)
   **          on entry, the n-by-n matrix a.
   **          on exit, a has been overwritten.
   **
   **  lda     (input) long int
   **          the leading dimension of the array a.  lda >= max(1,n).
   **
   **  wr      (output) BASE DATA TYPE array, dimension (n)
   **  wi      (output) BASE DATA TYPE array, dimension (n)
   **          wr and wi contain the real and imaginary parts,
   **          respectively, of the computed eigenvalues.  complex
   **          conjugate pairs of eigenvalues appear consecutively
   **          with the eigenvalue having the positive imaginary part
   **          first.
   **
   **  vl      (output) COMPLEX DATA TYPE array, dimension (ldvl,n)
   **          if jobvl = 'v', the left eigenvectors u(j) are stored one
   **          after another in the columns of vl, in the same order
   **          as their eigenvalues.
   **          if jobvl = 'n', vl is not referenced.
   **          if the j-th eigenvalue is real, then u(j) = vl(:,j),
   **          the j-th column of vl.
   **          if the j-th and (j+1)-st eigenvalues form a complex
   **          conjugate pair, then u(j) = vl(:,j) + i*vl(:,j+1) and
   **          u(j+1) = vl(:,j) - i*vl(:,j+1).
   **
   **  ldvl    (input) long int
   **          the leading dimension of the array vl.  ldvl >= 1; if
   **          jobvl = 'v', ldvl >= n.
   **
   **  vr      (output) COMPLEX DATA TYPE array, dimension (ldvr,n)
   **          if jobvr = 'v', the right eigenvectors v(j) are stored one
   **          after another in the columns of vr, in the same order
   **          as their eigenvalues.
   **          if jobvr = 'n', vr is not referenced.
   **          if the j-th eigenvalue is real, then v(j) = vr(:,j),
   **          the j-th column of vr.
   **          if the j-th and (j+1)-st eigenvalues form a complex
   **          conjugate pair, then v(j) = vr(:,j) + i*vr(:,j+1) and
   **          v(j+1) = vr(:,j) - i*vr(:,j+1).
   **
   **  ldvr    (input) long int
   **          the leading dimension of the array vr.  ldvr >= 1; if
   **          jobvr = 'v', ldvr >= n.
   **
   **  work    (workspace/output) BASE DATA TYPE array, dimension (max(1,lwork))
   **          on exit, if info = 0, work(1) returns the optimal lwork.
   **
   **  lwork   (input) long int
   **          the dimension of the array work.  lwork >= max(1,3*n), and
   **          if jobvl = 'v' or jobvr = 'v', lwork >= 4*n.  for good
   **          performance, lwork must generally be larger.
   **
   **          if lwork = -1, then a workspace query is assumed; the routine
   **          only calculates the optimal size of the work array, returns
   **          this value as the first entry of the work array, and no error
   **          message related to lwork is issued by xerbla.
   **
   **  info    (output) long int
   **          = 0:  successful exit
   **          < 0:  if info = -i, the i-th argument had an illegal value.
   **          > 0:  if info = i, the qr algorithm failed to compute all the
   **                eigenvalues, and no eigenvectors have been computed;
   **                elements i+1:n of wr and wi contain eigenvalues which
   **                have converged.
   **
   **/

  extern void DGEEV_FORTRAN(const char* jobvl, const char* jobvr, const long
                            int* n, double* a, const long int* lda, double* wr, double* wi, double* vl,
                            const long int* ldvl, double* vr, const long int* ldvr, double* work,
                            const long int* lwork, const long int* info);

} // end extern C
#endif

namespace Dune {

  namespace DynamicMatrixHelp {

    void eigenValuesNonsymLapackCall(
      const char* jobvl, const char* jobvr, const long
      int* n, double* a, const long int* lda, double* wr, double* wi, double* vl,
      const long int* ldvl, double* vr, const long int* ldvr, double* work,
      const long int* lwork, const long int* info)
    {
#if HAVE_LAPACK
      // call LAPACK dgeev
      DGEEV_FORTRAN(jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr,
                    work, lwork, info);
#else
      DUNE_THROW(NotImplemented,"eigenValuesNonsymLapackCall: LAPACK not found!");
#endif
    }

  } // end namespace FMatrixHelp

} // end namespace Dune
#endif