001:       SUBROUTINE CHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
002:      $                  INFO )
003: *
004: *  -- LAPACK driver routine (version 3.2) --
005: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
006: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
007: *     November 2006
008: *
009: *     .. Scalar Arguments ..
010:       CHARACTER          JOBZ, UPLO
011:       INTEGER            INFO, LDA, LWORK, N
012: *     ..
013: *     .. Array Arguments ..
014:       REAL               RWORK( * ), W( * )
015:       COMPLEX            A( LDA, * ), WORK( * )
016: *     ..
017: *
018: *  Purpose
019: *  =======
020: *
021: *  CHEEV computes all eigenvalues and, optionally, eigenvectors of a
022: *  complex Hermitian matrix A.
023: *
024: *  Arguments
025: *  =========
026: *
027: *  JOBZ    (input) CHARACTER*1
028: *          = 'N':  Compute eigenvalues only;
029: *          = 'V':  Compute eigenvalues and eigenvectors.
030: *
031: *  UPLO    (input) CHARACTER*1
032: *          = 'U':  Upper triangle of A is stored;
033: *          = 'L':  Lower triangle of A is stored.
034: *
035: *  N       (input) INTEGER
036: *          The order of the matrix A.  N >= 0.
037: *
038: *  A       (input/output) COMPLEX array, dimension (LDA, N)
039: *          On entry, the Hermitian matrix A.  If UPLO = 'U', the
040: *          leading N-by-N upper triangular part of A contains the
041: *          upper triangular part of the matrix A.  If UPLO = 'L',
042: *          the leading N-by-N lower triangular part of A contains
043: *          the lower triangular part of the matrix A.
044: *          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
045: *          orthonormal eigenvectors of the matrix A.
046: *          If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
047: *          or the upper triangle (if UPLO='U') of A, including the
048: *          diagonal, is destroyed.
049: *
050: *  LDA     (input) INTEGER
051: *          The leading dimension of the array A.  LDA >= max(1,N).
052: *
053: *  W       (output) REAL array, dimension (N)
054: *          If INFO = 0, the eigenvalues in ascending order.
055: *
056: *  WORK    (workspace/output) COMPLEX array, dimension (MAX(1,LWORK))
057: *          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
058: *
059: *  LWORK   (input) INTEGER
060: *          The length of the array WORK.  LWORK >= max(1,2*N-1).
061: *          For optimal efficiency, LWORK >= (NB+1)*N,
062: *          where NB is the blocksize for CHETRD returned by ILAENV.
063: *
064: *          If LWORK = -1, then a workspace query is assumed; the routine
065: *          only calculates the optimal size of the WORK array, returns
066: *          this value as the first entry of the WORK array, and no error
067: *          message related to LWORK is issued by XERBLA.
068: *
069: *  RWORK   (workspace) REAL array, dimension (max(1, 3*N-2))
070: *
071: *  INFO    (output) INTEGER
072: *          = 0:  successful exit
073: *          < 0:  if INFO = -i, the i-th argument had an illegal value
074: *          > 0:  if INFO = i, the algorithm failed to converge; i
075: *                off-diagonal elements of an intermediate tridiagonal
076: *                form did not converge to zero.
077: *
078: *  =====================================================================
079: *
080: *     .. Parameters ..
081:       REAL               ZERO, ONE
082:       PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
083:       COMPLEX            CONE
084:       PARAMETER          ( CONE = ( 1.0E0, 0.0E0 ) )
085: *     ..
086: *     .. Local Scalars ..
087:       LOGICAL            LOWER, LQUERY, WANTZ
088:       INTEGER            IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
089:      $                   LLWORK, LWKOPT, NB
090:       REAL               ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
091:      $                   SMLNUM
092: *     ..
093: *     .. External Functions ..
094:       LOGICAL            LSAME
095:       INTEGER            ILAENV
096:       REAL               CLANHE, SLAMCH
097:       EXTERNAL           ILAENV, LSAME, CLANHE, SLAMCH
098: *     ..
099: *     .. External Subroutines ..
100:       EXTERNAL           CHETRD, CLASCL, CSTEQR, CUNGTR, SSCAL, SSTERF,
101:      $                   XERBLA
102: *     ..
103: *     .. Intrinsic Functions ..
104:       INTRINSIC          MAX, SQRT
105: *     ..
106: *     .. Executable Statements ..
107: *
108: *     Test the input parameters.
109: *
110:       WANTZ = LSAME( JOBZ, 'V' )
111:       LOWER = LSAME( UPLO, 'L' )
112:       LQUERY = ( LWORK.EQ.-1 )
113: *
114:       INFO = 0
115:       IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
116:          INFO = -1
117:       ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
118:          INFO = -2
119:       ELSE IF( N.LT.0 ) THEN
120:          INFO = -3
121:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
122:          INFO = -5
123:       END IF
124: *
125:       IF( INFO.EQ.0 ) THEN
126:          NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 )
127:          LWKOPT = MAX( 1, ( NB+1 )*N )
128:          WORK( 1 ) = LWKOPT
129: *
130:          IF( LWORK.LT.MAX( 1, 2*N-1 ) .AND. .NOT.LQUERY )
131:      $      INFO = -8
132:       END IF
133: *
134:       IF( INFO.NE.0 ) THEN
135:          CALL XERBLA( 'CHEEV ', -INFO )
136:          RETURN
137:       ELSE IF( LQUERY ) THEN
138:          RETURN
139:       END IF
140: *
141: *     Quick return if possible
142: *
143:       IF( N.EQ.0 ) THEN
144:          RETURN
145:       END IF
146: *
147:       IF( N.EQ.1 ) THEN
148:          W( 1 ) = A( 1, 1 )
149:          WORK( 1 ) = 1
150:          IF( WANTZ )
151:      $      A( 1, 1 ) = CONE
152:          RETURN
153:       END IF
154: *
155: *     Get machine constants.
156: *
157:       SAFMIN = SLAMCH( 'Safe minimum' )
158:       EPS = SLAMCH( 'Precision' )
159:       SMLNUM = SAFMIN / EPS
160:       BIGNUM = ONE / SMLNUM
161:       RMIN = SQRT( SMLNUM )
162:       RMAX = SQRT( BIGNUM )
163: *
164: *     Scale matrix to allowable range, if necessary.
165: *
166:       ANRM = CLANHE( 'M', UPLO, N, A, LDA, RWORK )
167:       ISCALE = 0
168:       IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
169:          ISCALE = 1
170:          SIGMA = RMIN / ANRM
171:       ELSE IF( ANRM.GT.RMAX ) THEN
172:          ISCALE = 1
173:          SIGMA = RMAX / ANRM
174:       END IF
175:       IF( ISCALE.EQ.1 )
176:      $   CALL CLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
177: *
178: *     Call CHETRD to reduce Hermitian matrix to tridiagonal form.
179: *
180:       INDE = 1
181:       INDTAU = 1
182:       INDWRK = INDTAU + N
183:       LLWORK = LWORK - INDWRK + 1
184:       CALL CHETRD( UPLO, N, A, LDA, W, RWORK( INDE ), WORK( INDTAU ),
185:      $             WORK( INDWRK ), LLWORK, IINFO )
186: *
187: *     For eigenvalues only, call SSTERF.  For eigenvectors, first call
188: *     CUNGTR to generate the unitary matrix, then call CSTEQR.
189: *
190:       IF( .NOT.WANTZ ) THEN
191:          CALL SSTERF( N, W, RWORK( INDE ), INFO )
192:       ELSE
193:          CALL CUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ),
194:      $                LLWORK, IINFO )
195:          INDWRK = INDE + N
196:          CALL CSTEQR( JOBZ, N, W, RWORK( INDE ), A, LDA,
197:      $                RWORK( INDWRK ), INFO )
198:       END IF
199: *
200: *     If matrix was scaled, then rescale eigenvalues appropriately.
201: *
202:       IF( ISCALE.EQ.1 ) THEN
203:          IF( INFO.EQ.0 ) THEN
204:             IMAX = N
205:          ELSE
206:             IMAX = INFO - 1
207:          END IF
208:          CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
209:       END IF
210: *
211: *     Set WORK(1) to optimal complex workspace size.
212: *
213:       WORK( 1 ) = LWKOPT
214: *
215:       RETURN
216: *
217: *     End of CHEEV
218: *
219:       END
220: