d6/dae/zheevd_8f_source.html

*> \brief <b> ZHEEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices</b>

*

*  =========== DOCUMENTATION ===========

*

* Online html documentation available at

*            http://www.netlib.org/lapack/explore-html/

*

*> \htmlonly

*> Download ZHEEVD + dependencies

*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zheevd.f">

*> [TGZ]</a>

*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zheevd.f">

*> [ZIP]</a>

*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zheevd.f">

*> [TXT]</a>

*> \endhtmlonly

*

*  Definition:

*  ===========

*

*       SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,

*                          LRWORK, IWORK, LIWORK, INFO )

*

*       .. Scalar Arguments ..

*       CHARACTER          JOBZ, UPLO

*       INTEGER            INFO, LDA, LIWORK, LRWORK, LWORK, N

*       ..

*       .. Array Arguments ..

*       INTEGER            IWORK( * )

*       DOUBLE PRECISION   RWORK( * ), W( * )

*       COMPLEX*16         A( LDA, * ), WORK( * )

*       ..

*

*

*> \par Purpose:

*  =============

*>

*> \verbatim

*>

*> ZHEEVD computes all eigenvalues and, optionally, eigenvectors of a

*> complex Hermitian matrix A.  If eigenvectors are desired, it uses a

*> divide and conquer algorithm.

*>

*> \endverbatim

*

*  Arguments:

*  ==========

*

*> \param[in] JOBZ

*> \verbatim

*>          JOBZ is CHARACTER*1

*>          = 'N':  Compute eigenvalues only;

*>          = 'V':  Compute eigenvalues and eigenvectors.

*> \endverbatim

*>

*> \param[in] UPLO

*> \verbatim

*>          UPLO is CHARACTER*1

*>          = 'U':  Upper triangle of A is stored;

*>          = 'L':  Lower triangle of A is stored.

*> \endverbatim

*>

*> \param[in] N

*> \verbatim

*>          N is INTEGER

*>          The order of the matrix A.  N >= 0.

*> \endverbatim

*>

*> \param[in,out] A

*> \verbatim

*>          A is COMPLEX*16 array, dimension (LDA, N)

*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the

*>          leading N-by-N upper triangular part of A contains 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.

*> \endverbatim

*>

*> \param[in] LDA

*> \verbatim

*>          LDA is INTEGER

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

*> \endverbatim

*>

*> \param[out] W

*> \verbatim

*>          W is DOUBLE PRECISION array, dimension (N)

*>          If INFO = 0, the eigenvalues in ascending order.

*> \endverbatim

*>

*> \param[out] WORK

*> \verbatim

*>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))

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

*> \endverbatim

*>

*> \param[in] LWORK

*> \verbatim

*>          LWORK is INTEGER

*>          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 sizes of the WORK, RWORK and

*>          IWORK arrays, returns these values as the first entries of

*>          the WORK, RWORK and IWORK arrays, and no error message

*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.

*> \endverbatim

*>

*> \param[out] RWORK

*> \verbatim

*>          RWORK is DOUBLE PRECISION array,

*>                                         dimension (LRWORK)

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

*> \endverbatim

*>

*> \param[in] LRWORK

*> \verbatim

*>          LRWORK is INTEGER

*>          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 sizes of the WORK, RWORK

*>          and IWORK arrays, returns these values as the first entries

*>          of the WORK, RWORK and IWORK arrays, and no error message

*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.

*> \endverbatim

*>

*> \param[out] IWORK

*> \verbatim

*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))

*>          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.

*> \endverbatim

*>

*> \param[in] LIWORK

*> \verbatim

*>          LIWORK is INTEGER

*>          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 sizes of the WORK, RWORK

*>          and IWORK arrays, returns these values as the first entries

*>          of the WORK, RWORK and IWORK arrays, and no error message

*>          related to LWORK or LRWORK or LIWORK is issued by XERBLA.

*> \endverbatim

*>

*> \param[out] INFO

*> \verbatim

*>          INFO is INTEGER

*>          = 0:  successful exit

*>          < 0:  if INFO = -i, the i-th argument had an illegal value

*>          > 0:  if INFO = i and JOBZ = 'N', then the algorithm failed

*>                to converge; i off-diagonal elements of an intermediate

*>                tridiagonal form did not converge to zero;

*>                if INFO = i and JOBZ = 'V', then the algorithm failed

*>                to compute an eigenvalue while working on the submatrix

*>                lying in rows and columns INFO/(N+1) through

*>                mod(INFO,N+1).

*> \endverbatim

*

*  Authors:

*  ========

*

*> \author Univ. of Tennessee

*> \author Univ. of California Berkeley

*> \author Univ. of Colorado Denver

*> \author NAG Ltd.

*

*> \ingroup heevd

*

*> \par Further Details:

*  =====================

*>

*>  Modified description of INFO. Sven, 16 Feb 05.

*

*> \par Contributors:

*  ==================

*>

*> Jeff Rutter, Computer Science Division, University of California

*> at Berkeley, USA

*>

*  =====================================================================

      SUBROUTINE zheevd( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,

     $                   LRWORK, IWORK, LIWORK, INFO )

*

*  -- LAPACK driver routine --

*  -- LAPACK is a software package provided by Univ. of Tennessee,    --

*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--

*

*     .. Scalar Arguments ..

      CHARACTER          JOBZ, UPLO

      INTEGER            INFO, LDA, LIWORK, LRWORK, LWORK, N

*     ..

*     .. Array Arguments ..

      INTEGER            IWORK( * )

      DOUBLE PRECISION   RWORK( * ), W( * )

      COMPLEX*16         A( LDA, * ), WORK( * )

*     ..

*

*  =====================================================================

*

*     .. Parameters ..

      DOUBLE PRECISION   ZERO, ONE

      parameter( zero = 0.0d0, one = 1.0d0 )

      COMPLEX*16         CONE

      parameter( cone = ( 1.0d0, 0.0d0 ) )

*     ..

*     .. Local Scalars ..

      LOGICAL            LOWER, LQUERY, WANTZ

      INTEGER            IINFO, IMAX, INDE, INDRWK, INDTAU, INDWK2,

     $                   indwrk, iscale, liopt, liwmin, llrwk, llwork,

     $                   llwrk2, lopt, lropt, lrwmin, lwmin

      DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,

     $                   smlnum

*     ..

*     .. External Functions ..

      LOGICAL            LSAME

      INTEGER            ILAENV

      DOUBLE PRECISION   DLAMCH, ZLANHE

      EXTERNAL           lsame, ilaenv, dlamch, zlanhe

*     ..

*     .. External Subroutines ..

      EXTERNAL           dscal, dsterf, xerbla, zhetrd, zlacpy, zlascl,

     $                   zstedc, zunmtr

*     ..

*     .. Intrinsic Functions ..

      INTRINSIC          max, sqrt

*     ..

*     .. Executable Statements ..

*

*     Test the input parameters.

*

      wantz = lsame( jobz, 'V' )

      lower = lsame( uplo, 'L' )

      lquery = ( lwork.EQ.-1 .OR. lrwork.EQ.-1 .OR. liwork.EQ.-1 )

*

      info = 0

      IF( .NOT.( wantz .OR. lsame( jobz, 'N' ) ) ) THEN

         info = -1

      ELSE IF( .NOT.( lower .OR. lsame( uplo, 'U' ) ) ) THEN

         info = -2

      ELSE IF( n.LT.0 ) THEN

         info = -3

      ELSE IF( lda.LT.max( 1, n ) ) THEN

         info = -5

      END IF

*

      IF( info.EQ.0 ) THEN

         IF( n.LE.1 ) THEN

            lwmin = 1

            lrwmin = 1

            liwmin = 1

            lopt = lwmin

            lropt = lrwmin

            liopt = liwmin

         ELSE

            IF( wantz ) THEN

               lwmin = 2*n + n*n

               lrwmin = 1 + 5*n + 2*n**2

               liwmin = 3 + 5*n

            ELSE

               lwmin = n + 1

               lrwmin = n

               liwmin = 1

            END IF

            lopt = max( lwmin, n +

     $                  n*ilaenv( 1, 'ZHETRD', uplo, n, -1, -1, -1 ) )

            lropt = lrwmin

            liopt = liwmin

         END IF

         work( 1 ) = lopt

         rwork( 1 ) = lropt

         iwork( 1 ) = liopt

*

         IF( lwork.LT.lwmin .AND. .NOT.lquery ) THEN

            info = -8

         ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery ) THEN

            info = -10

         ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery ) THEN

            info = -12

         END IF

      END IF

*

      IF( info.NE.0 ) THEN

         CALL xerbla( 'ZHEEVD', -info )

         RETURN

      ELSE IF( lquery ) THEN

         RETURN

      END IF

*

*     Quick return if possible

*

      IF( n.EQ.0 )

     $   RETURN

*

      IF( n.EQ.1 ) THEN

         w( 1 ) = dble( a( 1, 1 ) )

         IF( wantz )

     $      a( 1, 1 ) = cone

         RETURN

      END IF

*

*     Get machine constants.

*

      safmin = dlamch( 'Safe minimum' )

      eps = dlamch( 'Precision' )

      smlnum = safmin / eps

      bignum = one / smlnum

      rmin = sqrt( smlnum )

      rmax = sqrt( bignum )

*

*     Scale matrix to allowable range, if necessary.

*

      anrm = zlanhe( 'M', uplo, n, a, lda, rwork )

      iscale = 0

      IF( anrm.GT.zero .AND. anrm.LT.rmin ) THEN

         iscale = 1

         sigma = rmin / anrm

      ELSE IF( anrm.GT.rmax ) THEN

         iscale = 1

         sigma = rmax / anrm

      END IF

      IF( iscale.EQ.1 )

     $   CALL zlascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )

*

*     Call ZHETRD to reduce Hermitian matrix to tridiagonal form.

*

      inde = 1

      indtau = 1

      indwrk = indtau + n

      indrwk = inde + n

      indwk2 = indwrk + n*n

      llwork = lwork - indwrk + 1

      llwrk2 = lwork - indwk2 + 1

      llrwk = lrwork - indrwk + 1

      CALL zhetrd( uplo, n, a, lda, w, rwork( inde ), work( indtau ),

     $             work( indwrk ), llwork, iinfo )

*

*     For eigenvalues only, call DSTERF.  For eigenvectors, first call

*     ZSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the

*     tridiagonal matrix, then call ZUNMTR to multiply it to the

*     Householder transformations represented as Householder vectors in

*     A.

*

      IF( .NOT.wantz ) THEN

         CALL dsterf( n, w, rwork( inde ), info )

      ELSE

         CALL zstedc( 'I', n, w, rwork( inde ), work( indwrk ), n,

     $                work( indwk2 ), llwrk2, rwork( indrwk ), llrwk,

     $                iwork, liwork, info )

         CALL zunmtr( 'L', uplo, 'N', n, n, a, lda, work( indtau ),

     $                work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )

         CALL zlacpy( 'A', n, n, work( indwrk ), n, a, lda )

      END IF

*

*     If matrix was scaled, then rescale eigenvalues appropriately.

*

      IF( iscale.EQ.1 ) THEN

         IF( info.EQ.0 ) THEN

            imax = n

         ELSE

            imax = info - 1

         END IF

         CALL dscal( imax, one / sigma, w, 1 )

      END IF

*

      work( 1 ) = lopt

      rwork( 1 ) = lropt

      iwork( 1 ) = liopt

*

      RETURN

*

*     End of ZHEEVD

*

      END

xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285

zheevd
subroutine zheevd(jobz, uplo, n, a, lda, w, work, lwork, rwork, lrwork, iwork, liwork, info)
ZHEEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices
Definition zheevd.f:199

zhetrd
subroutine zhetrd(uplo, n, a, lda, d, e, tau, work, lwork, info)
ZHETRD
Definition zhetrd.f:192

zlacpy
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
Definition zlacpy.f:103

zlascl
subroutine zlascl(type, kl, ku, cfrom, cto, m, n, a, lda, info)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition zlascl.f:143

dscal
subroutine dscal(n, da, dx, incx)
DSCAL
Definition dscal.f:79

zstedc
subroutine zstedc(compz, n, d, e, z, ldz, work, lwork, rwork, lrwork, iwork, liwork, info)
ZSTEDC
Definition zstedc.f:206

dsterf
subroutine dsterf(n, d, e, info)
DSTERF
Definition dsterf.f:86

zunmtr
subroutine zunmtr(side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork, info)
ZUNMTR
Definition zunmtr.f:171