#include "ESMF_LapackBlas.inc" !> \brief <b> DSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b> ! ! =========== DOCUMENTATION =========== ! ! Online html documentation available at ! http://www.netlib.org/lapack/explore-html/ ! !> \htmlonly !> Download DSYEVD + dependencies !> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyevd.f"> !> [TGZ]</a> !> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyevd.f"> !> [ZIP]</a> !> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyevd.f"> !> [TXT]</a> !> \endhtmlonly ! ! Definition: ! =========== ! ! SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, ! LIWORK, INFO ) ! ! .. Scalar Arguments .. ! CHARACTER JOBZ, UPLO ! INTEGER INFO, LDA, LIWORK, LWORK, N ! .. ! .. Array Arguments .. ! INTEGER IWORK( * ) ! DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * ) ! .. ! ! !> \par Purpose: ! ============= !> !> \verbatim !> !> DSYEVD computes all eigenvalues and, optionally, eigenvectors of a !> real symmetric 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. !> !> Because of large use of BLAS of level 3, DSYEVD needs N**2 more !> workspace than DSYEVX. !> \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 DOUBLE PRECISION array, dimension (LDA, N) !> On entry, the symmetric 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 DOUBLE PRECISION array, !> dimension (LWORK) !> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. !> \endverbatim !> !> \param[in] LWORK !> \verbatim !> LWORK is INTEGER !> The dimension of the array WORK. !> If N <= 1, LWORK must be at least 1. !> If JOBZ = 'N' and N > 1, LWORK must be at least 2*N+1. !> If JOBZ = 'V' and N > 1, LWORK must be at least !> 1 + 6*N + 2*N**2. !> !> If LWORK = -1, then a workspace query is assumed; the routine !> only calculates the optimal sizes of the WORK and IWORK !> arrays, returns these values as the first entries of the WORK !> and IWORK arrays, and no error message related to LWORK 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 and !> IWORK arrays, returns these values as the first entries of !> the WORK and IWORK arrays, and no error message related to !> LWORK 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. ! !> \date December 2016 ! !> \ingroup doubleSYeigen ! !> \par Contributors: ! ================== !> !> Jeff Rutter, Computer Science Division, University of California !> at Berkeley, USA \n !> Modified by Francoise Tisseur, University of Tennessee \n !> Modified description of INFO. Sven, 16 Feb 05. \n !> ! ===================================================================== SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, & LIWORK, INFO ) ! ! -- LAPACK driver routine (version 3.7.0) -- ! -- LAPACK is a software package provided by Univ. of Tennessee, -- ! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- ! December 2016 ! ! .. Scalar Arguments .. CHARACTER JOBZ, UPLO INTEGER INFO, LDA, LIWORK, LWORK, N ! .. ! .. Array Arguments .. INTEGER IWORK( * ) DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * ) ! .. ! ! ===================================================================== ! ! .. Parameters .. DOUBLE PRECISION ZERO, ONE PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) ! .. ! .. Local Scalars .. ! LOGICAL LOWER, LQUERY, WANTZ INTEGER IINFO, INDE, INDTAU, INDWK2, INDWRK, ISCALE, & LIOPT, LIWMIN, LLWORK, LLWRK2, LOPT, LWMIN DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, & SMLNUM ! .. ! .. External Functions .. LOGICAL LSAME INTEGER ILAENV DOUBLE PRECISION DLAMCH, DLANSY EXTERNAL LSAME, DLAMCH, DLANSY, ILAENV ! .. ! .. External Subroutines .. EXTERNAL DLACPY, DLASCL, DORMTR, DSCAL, DSTEDC, DSTERF, & DSYTRD, XERBLA ! .. ! .. Intrinsic Functions .. INTRINSIC MAX, SQRT ! .. ! .. Executable Statements .. ! ! Test the input parameters. ! WANTZ = LSAME( JOBZ, 'V' ) LOWER = LSAME( UPLO, 'L' ) LQUERY = ( LWORK.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 LIWMIN = 1 LWMIN = 1 LOPT = LWMIN LIOPT = LIWMIN ELSE IF( WANTZ ) THEN LIWMIN = 3 + 5*N LWMIN = 1 + 6*N + 2*N**2 ELSE LIWMIN = 1 LWMIN = 2*N + 1 END IF LOPT = MAX( LWMIN, 2*N + & ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) ) LIOPT = LIWMIN END IF WORK( 1 ) = LOPT IWORK( 1 ) = LIOPT ! IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN INFO = -8 ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN INFO = -10 END IF END IF ! IF( INFO.NE.0 ) THEN CALL XERBLA( 'DSYEVD', -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 ) = A( 1, 1 ) IF( WANTZ ) & A( 1, 1 ) = ONE 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 = DLANSY( 'M', UPLO, N, A, LDA, WORK ) 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 DLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO ) ! ! Call DSYTRD to reduce symmetric matrix to tridiagonal form. ! INDE = 1 INDTAU = INDE + N INDWRK = INDTAU + N LLWORK = LWORK - INDWRK + 1 INDWK2 = INDWRK + N*N LLWRK2 = LWORK - INDWK2 + 1 ! CALL DSYTRD( UPLO, N, A, LDA, W, WORK( INDE ), WORK( INDTAU ), & WORK( INDWRK ), LLWORK, IINFO ) ! ! For eigenvalues only, call DSTERF. For eigenvectors, first call ! DSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the ! tridiagonal matrix, then call DORMTR to multiply it by the ! Householder transformations stored in A. ! IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, WORK( INDE ), INFO ) ELSE CALL DSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N, & WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO ) CALL DORMTR( 'L', UPLO, 'N', N, N, A, LDA, WORK( INDTAU ), & WORK( INDWRK ), N, WORK( INDWK2 ), LLWRK2, IINFO ) CALL DLACPY( 'A', N, N, WORK( INDWRK ), N, A, LDA ) END IF ! ! If matrix was scaled, then rescale eigenvalues appropriately. ! IF( ISCALE.EQ.1 ) & CALL DSCAL( N, ONE / SIGMA, W, 1 ) ! WORK( 1 ) = LOPT IWORK( 1 ) = LIOPT ! RETURN ! ! End of DSYEVD ! END