Contents


NAME

     cheevd - compute all eigenvalues and, optionally,  eigenvec-
     tors of a complex Hermitian matrix A

SYNOPSIS

     SUBROUTINE CHEEVD(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
           LRWORK, IWORK, LIWORK, INFO)

     CHARACTER * 1 JOBZ, UPLO
     COMPLEX A(LDA,*), WORK(*)
     INTEGER N, LDA, LWORK, LRWORK, LIWORK, INFO
     INTEGER IWORK(*)
     REAL W(*), RWORK(*)

     SUBROUTINE CHEEVD_64(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
           LRWORK, IWORK, LIWORK, INFO)

     CHARACTER * 1 JOBZ, UPLO
     COMPLEX A(LDA,*), WORK(*)
     INTEGER*8 N, LDA, LWORK, LRWORK, LIWORK, INFO
     INTEGER*8 IWORK(*)
     REAL W(*), RWORK(*)

  F95 INTERFACE
     SUBROUTINE HEEVD(JOBZ, UPLO, [N], A, [LDA], W, [WORK], [LWORK],
            [RWORK], [LRWORK], [IWORK], [LIWORK], [INFO])

     CHARACTER(LEN=1) :: JOBZ, UPLO
     COMPLEX, DIMENSION(:) :: WORK
     COMPLEX, DIMENSION(:,:) :: A
     INTEGER :: N, LDA, LWORK, LRWORK, LIWORK, INFO
     INTEGER, DIMENSION(:) :: IWORK
     REAL, DIMENSION(:) :: W, RWORK

     SUBROUTINE HEEVD_64(JOBZ, UPLO, [N], A, [LDA], W, [WORK], [LWORK],
            [RWORK], [LRWORK], [IWORK], [LIWORK], [INFO])

     CHARACTER(LEN=1) :: JOBZ, UPLO
     COMPLEX, DIMENSION(:) :: WORK
     COMPLEX, DIMENSION(:,:) :: A
     INTEGER(8) :: N, LDA, LWORK, LRWORK, LIWORK, INFO
     INTEGER(8), DIMENSION(:) :: IWORK
     REAL, DIMENSION(:) :: W, RWORK

  C INTERFACE
     #include <sunperf.h>
     void cheevd(char jobz, char uplo, int  n,  complex  *a,  int
               lda, float *w, int *info);

     void cheevd_64(char jobz, char uplo,  long  n,  complex  *a,
               long lda, float *w, long *info);

PURPOSE

     cheevd computes all eigenvalues and,  optionally,  eigenvec-
     tors  of  a complex Hermitian matrix A.  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

     JOBZ (input)
               = 'N':  Compute eigenvalues only;
               = 'V':  Compute eigenvalues and eigenvectors.

     UPLO (input)
               = 'U':  Upper triangle of A is stored;
               = 'L':  Lower triangle of A is stored.

     N (input) The order of the matrix A.  N >= 0.

     A (input/output)
               On entry, the Hermitian matrix A.  If UPLO =  'U',
               the leading N-by-N upper triangular part of A con-
               tains the upper triangular part of the  matrix  A.
               If UPLO = 'L', the leading N-by-N lower triangular
               part of A contains the lower  triangular  part  of
               the  matrix  A.   On  exit, if JOBZ = 'V', then if
               INFO = 0, A contains the orthonormal  eigenvectors
               of  the matrix A.  If JOBZ = 'N', then on exit the
               lower triangle (if UPLO='L') or the upper triangle
               (if  UPLO='U')  of  A,  including the diagonal, is
               destroyed.

     LDA (input)
               The leading dimension of  the  array  A.   LDA  >=
               max(1,N).

     W (output)
               If INFO = 0, the eigenvalues in ascending order.

     WORK (workspace)
               On exit, if INFO = 0, WORK(1) returns the  optimal
               LWORK.

     LWORK (input)
               The  length  of  the  array  WORK.   If  N  <=  1,
               LWORK  must be at least 1.  If JOBZ  = 'N' and N >
               1, LWORK must be at least N + 1.  If JOBZ   =  'V'
               and N > 1, LWORK must be at least 2*N + N**2.

               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.

     RWORK (workspace)
               dimension (LRWORK) On exit, if INFO = 0,  RWORK(1)
               returns the optimal LRWORK.

     LRWORK (input)
               The dimension of the array  RWORK.   If  N  <=  1,
               LRWORK must be at least 1.  If JOBZ  = 'N' and N >
               1, LRWORK must be at least N.  If JOBZ  = 'V'  and
               N > 1, LRWORK must be at least 1 + 5*N + 2*N**2.

               If LRWORK = -1, then a workspace query is assumed;
               the  routine  only  calculates the optimal size of
               the RWORK array, returns this value as  the  first
               entry  of  the  RWORK  array, and no error message
               related to LRWORK is issued by XERBLA.

     IWORK (workspace/output)
               On exit, if INFO = 0, IWORK(1) returns the optimal
               LIWORK.

     LIWORK (input)
               The dimension of the array  IWORK.   If  N  <=  1,
               LIWORK must be at least 1.  If JOBZ  = 'N' and N >
               1, LIWORK must be at least 1.  If JOBZ  = 'V'  and
               N > 1, LIWORK must be at least 3 + 5*N.

               If LIWORK = -1, then a workspace query is assumed;
               the  routine  only  calculates the optimal size of
               the IWORK array, returns this value as  the  first
               entry  of  the  IWORK  array, and no error message
               related to LIWORK is issued by XERBLA.

     INFO (output)
               = 0:  successful exit
               < 0:  if INFO = -i, the i-th argument had an ille-
               gal value
               > 0:  if INFO = i, the algorithm  failed  to  con-
               verge;  i off-diagonal elements of an intermediate
               tridiagonal form did not converge to zero.

FURTHER DETAILS

     Based on contributions by
        Jeff Rutter, Computer  Science  Division,  University  of
     California
        at Berkeley, USA