![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief <b> ZHEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices</b> 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZHEEV + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zheev.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zheev.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zheev.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, 00022 * INFO ) 00023 * 00024 * .. Scalar Arguments .. 00025 * CHARACTER JOBZ, UPLO 00026 * INTEGER INFO, LDA, LWORK, N 00027 * .. 00028 * .. Array Arguments .. 00029 * DOUBLE PRECISION RWORK( * ), W( * ) 00030 * COMPLEX*16 A( LDA, * ), WORK( * ) 00031 * .. 00032 * 00033 * 00034 *> \par Purpose: 00035 * ============= 00036 *> 00037 *> \verbatim 00038 *> 00039 *> ZHEEV computes all eigenvalues and, optionally, eigenvectors of a 00040 *> complex Hermitian matrix A. 00041 *> \endverbatim 00042 * 00043 * Arguments: 00044 * ========== 00045 * 00046 *> \param[in] JOBZ 00047 *> \verbatim 00048 *> JOBZ is CHARACTER*1 00049 *> = 'N': Compute eigenvalues only; 00050 *> = 'V': Compute eigenvalues and eigenvectors. 00051 *> \endverbatim 00052 *> 00053 *> \param[in] UPLO 00054 *> \verbatim 00055 *> UPLO is CHARACTER*1 00056 *> = 'U': Upper triangle of A is stored; 00057 *> = 'L': Lower triangle of A is stored. 00058 *> \endverbatim 00059 *> 00060 *> \param[in] N 00061 *> \verbatim 00062 *> N is INTEGER 00063 *> The order of the matrix A. N >= 0. 00064 *> \endverbatim 00065 *> 00066 *> \param[in,out] A 00067 *> \verbatim 00068 *> A is COMPLEX*16 array, dimension (LDA, N) 00069 *> On entry, the Hermitian matrix A. If UPLO = 'U', the 00070 *> leading N-by-N upper triangular part of A contains the 00071 *> upper triangular part of the matrix A. If UPLO = 'L', 00072 *> the leading N-by-N lower triangular part of A contains 00073 *> the lower triangular part of the matrix A. 00074 *> On exit, if JOBZ = 'V', then if INFO = 0, A contains the 00075 *> orthonormal eigenvectors of the matrix A. 00076 *> If JOBZ = 'N', then on exit the lower triangle (if UPLO='L') 00077 *> or the upper triangle (if UPLO='U') of A, including the 00078 *> diagonal, is destroyed. 00079 *> \endverbatim 00080 *> 00081 *> \param[in] LDA 00082 *> \verbatim 00083 *> LDA is INTEGER 00084 *> The leading dimension of the array A. LDA >= max(1,N). 00085 *> \endverbatim 00086 *> 00087 *> \param[out] W 00088 *> \verbatim 00089 *> W is DOUBLE PRECISION array, dimension (N) 00090 *> If INFO = 0, the eigenvalues in ascending order. 00091 *> \endverbatim 00092 *> 00093 *> \param[out] WORK 00094 *> \verbatim 00095 *> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) 00096 *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. 00097 *> \endverbatim 00098 *> 00099 *> \param[in] LWORK 00100 *> \verbatim 00101 *> LWORK is INTEGER 00102 *> The length of the array WORK. LWORK >= max(1,2*N-1). 00103 *> For optimal efficiency, LWORK >= (NB+1)*N, 00104 *> where NB is the blocksize for ZHETRD returned by ILAENV. 00105 *> 00106 *> If LWORK = -1, then a workspace query is assumed; the routine 00107 *> only calculates the optimal size of the WORK array, returns 00108 *> this value as the first entry of the WORK array, and no error 00109 *> message related to LWORK is issued by XERBLA. 00110 *> \endverbatim 00111 *> 00112 *> \param[out] RWORK 00113 *> \verbatim 00114 *> RWORK is DOUBLE PRECISION array, dimension (max(1, 3*N-2)) 00115 *> \endverbatim 00116 *> 00117 *> \param[out] INFO 00118 *> \verbatim 00119 *> INFO is INTEGER 00120 *> = 0: successful exit 00121 *> < 0: if INFO = -i, the i-th argument had an illegal value 00122 *> > 0: if INFO = i, the algorithm failed to converge; i 00123 *> off-diagonal elements of an intermediate tridiagonal 00124 *> form did not converge to zero. 00125 *> \endverbatim 00126 * 00127 * Authors: 00128 * ======== 00129 * 00130 *> \author Univ. of Tennessee 00131 *> \author Univ. of California Berkeley 00132 *> \author Univ. of Colorado Denver 00133 *> \author NAG Ltd. 00134 * 00135 *> \date November 2011 00136 * 00137 *> \ingroup complex16HEeigen 00138 * 00139 * ===================================================================== 00140 SUBROUTINE ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, 00141 $ INFO ) 00142 * 00143 * -- LAPACK driver routine (version 3.4.0) -- 00144 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00145 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00146 * November 2011 00147 * 00148 * .. Scalar Arguments .. 00149 CHARACTER JOBZ, UPLO 00150 INTEGER INFO, LDA, LWORK, N 00151 * .. 00152 * .. Array Arguments .. 00153 DOUBLE PRECISION RWORK( * ), W( * ) 00154 COMPLEX*16 A( LDA, * ), WORK( * ) 00155 * .. 00156 * 00157 * ===================================================================== 00158 * 00159 * .. Parameters .. 00160 DOUBLE PRECISION ZERO, ONE 00161 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 00162 COMPLEX*16 CONE 00163 PARAMETER ( CONE = ( 1.0D0, 0.0D0 ) ) 00164 * .. 00165 * .. Local Scalars .. 00166 LOGICAL LOWER, LQUERY, WANTZ 00167 INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE, 00168 $ LLWORK, LWKOPT, NB 00169 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, 00170 $ SMLNUM 00171 * .. 00172 * .. External Functions .. 00173 LOGICAL LSAME 00174 INTEGER ILAENV 00175 DOUBLE PRECISION DLAMCH, ZLANHE 00176 EXTERNAL LSAME, ILAENV, DLAMCH, ZLANHE 00177 * .. 00178 * .. External Subroutines .. 00179 EXTERNAL DSCAL, DSTERF, XERBLA, ZHETRD, ZLASCL, ZSTEQR, 00180 $ ZUNGTR 00181 * .. 00182 * .. Intrinsic Functions .. 00183 INTRINSIC MAX, SQRT 00184 * .. 00185 * .. Executable Statements .. 00186 * 00187 * Test the input parameters. 00188 * 00189 WANTZ = LSAME( JOBZ, 'V' ) 00190 LOWER = LSAME( UPLO, 'L' ) 00191 LQUERY = ( LWORK.EQ.-1 ) 00192 * 00193 INFO = 0 00194 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN 00195 INFO = -1 00196 ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN 00197 INFO = -2 00198 ELSE IF( N.LT.0 ) THEN 00199 INFO = -3 00200 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00201 INFO = -5 00202 END IF 00203 * 00204 IF( INFO.EQ.0 ) THEN 00205 NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) 00206 LWKOPT = MAX( 1, ( NB+1 )*N ) 00207 WORK( 1 ) = LWKOPT 00208 * 00209 IF( LWORK.LT.MAX( 1, 2*N-1 ) .AND. .NOT.LQUERY ) 00210 $ INFO = -8 00211 END IF 00212 * 00213 IF( INFO.NE.0 ) THEN 00214 CALL XERBLA( 'ZHEEV ', -INFO ) 00215 RETURN 00216 ELSE IF( LQUERY ) THEN 00217 RETURN 00218 END IF 00219 * 00220 * Quick return if possible 00221 * 00222 IF( N.EQ.0 ) THEN 00223 RETURN 00224 END IF 00225 * 00226 IF( N.EQ.1 ) THEN 00227 W( 1 ) = A( 1, 1 ) 00228 WORK( 1 ) = 1 00229 IF( WANTZ ) 00230 $ A( 1, 1 ) = CONE 00231 RETURN 00232 END IF 00233 * 00234 * Get machine constants. 00235 * 00236 SAFMIN = DLAMCH( 'Safe minimum' ) 00237 EPS = DLAMCH( 'Precision' ) 00238 SMLNUM = SAFMIN / EPS 00239 BIGNUM = ONE / SMLNUM 00240 RMIN = SQRT( SMLNUM ) 00241 RMAX = SQRT( BIGNUM ) 00242 * 00243 * Scale matrix to allowable range, if necessary. 00244 * 00245 ANRM = ZLANHE( 'M', UPLO, N, A, LDA, RWORK ) 00246 ISCALE = 0 00247 IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN 00248 ISCALE = 1 00249 SIGMA = RMIN / ANRM 00250 ELSE IF( ANRM.GT.RMAX ) THEN 00251 ISCALE = 1 00252 SIGMA = RMAX / ANRM 00253 END IF 00254 IF( ISCALE.EQ.1 ) 00255 $ CALL ZLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO ) 00256 * 00257 * Call ZHETRD to reduce Hermitian matrix to tridiagonal form. 00258 * 00259 INDE = 1 00260 INDTAU = 1 00261 INDWRK = INDTAU + N 00262 LLWORK = LWORK - INDWRK + 1 00263 CALL ZHETRD( UPLO, N, A, LDA, W, RWORK( INDE ), WORK( INDTAU ), 00264 $ WORK( INDWRK ), LLWORK, IINFO ) 00265 * 00266 * For eigenvalues only, call DSTERF. For eigenvectors, first call 00267 * ZUNGTR to generate the unitary matrix, then call ZSTEQR. 00268 * 00269 IF( .NOT.WANTZ ) THEN 00270 CALL DSTERF( N, W, RWORK( INDE ), INFO ) 00271 ELSE 00272 CALL ZUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ), 00273 $ LLWORK, IINFO ) 00274 INDWRK = INDE + N 00275 CALL ZSTEQR( JOBZ, N, W, RWORK( INDE ), A, LDA, 00276 $ RWORK( INDWRK ), INFO ) 00277 END IF 00278 * 00279 * If matrix was scaled, then rescale eigenvalues appropriately. 00280 * 00281 IF( ISCALE.EQ.1 ) THEN 00282 IF( INFO.EQ.0 ) THEN 00283 IMAX = N 00284 ELSE 00285 IMAX = INFO - 1 00286 END IF 00287 CALL DSCAL( IMAX, ONE / SIGMA, W, 1 ) 00288 END IF 00289 * 00290 * Set WORK(1) to optimal complex workspace size. 00291 * 00292 WORK( 1 ) = LWKOPT 00293 * 00294 RETURN 00295 * 00296 * End of ZHEEV 00297 * 00298 END