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