You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

zheevr.f 26 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730
  1. *> \brief <b> ZHEEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices</b>
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download ZHEEVR + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zheevr.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zheevr.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zheevr.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
  22. * ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
  23. * RWORK, LRWORK, IWORK, LIWORK, INFO )
  24. *
  25. * .. Scalar Arguments ..
  26. * CHARACTER JOBZ, RANGE, UPLO
  27. * INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LRWORK, LWORK,
  28. * $ M, N
  29. * DOUBLE PRECISION ABSTOL, VL, VU
  30. * ..
  31. * .. Array Arguments ..
  32. * INTEGER ISUPPZ( * ), IWORK( * )
  33. * DOUBLE PRECISION RWORK( * ), W( * )
  34. * COMPLEX*16 A( LDA, * ), WORK( * ), Z( LDZ, * )
  35. * ..
  36. *
  37. *
  38. *> \par Purpose:
  39. * =============
  40. *>
  41. *> \verbatim
  42. *>
  43. *> ZHEEVR computes selected eigenvalues and, optionally, eigenvectors
  44. *> of a complex Hermitian matrix A. Eigenvalues and eigenvectors can
  45. *> be selected by specifying either a range of values or a range of
  46. *> indices for the desired eigenvalues.
  47. *>
  48. *> ZHEEVR first reduces the matrix A to tridiagonal form T with a call
  49. *> to ZHETRD. Then, whenever possible, ZHEEVR calls ZSTEMR to compute
  50. *> eigenspectrum using Relatively Robust Representations. ZSTEMR
  51. *> computes eigenvalues by the dqds algorithm, while orthogonal
  52. *> eigenvectors are computed from various "good" L D L^T representations
  53. *> (also known as Relatively Robust Representations). Gram-Schmidt
  54. *> orthogonalization is avoided as far as possible. More specifically,
  55. *> the various steps of the algorithm are as follows.
  56. *>
  57. *> For each unreduced block (submatrix) of T,
  58. *> (a) Compute T - sigma I = L D L^T, so that L and D
  59. *> define all the wanted eigenvalues to high relative accuracy.
  60. *> This means that small relative changes in the entries of D and L
  61. *> cause only small relative changes in the eigenvalues and
  62. *> eigenvectors. The standard (unfactored) representation of the
  63. *> tridiagonal matrix T does not have this property in general.
  64. *> (b) Compute the eigenvalues to suitable accuracy.
  65. *> If the eigenvectors are desired, the algorithm attains full
  66. *> accuracy of the computed eigenvalues only right before
  67. *> the corresponding vectors have to be computed, see steps c) and d).
  68. *> (c) For each cluster of close eigenvalues, select a new
  69. *> shift close to the cluster, find a new factorization, and refine
  70. *> the shifted eigenvalues to suitable accuracy.
  71. *> (d) For each eigenvalue with a large enough relative separation compute
  72. *> the corresponding eigenvector by forming a rank revealing twisted
  73. *> factorization. Go back to (c) for any clusters that remain.
  74. *>
  75. *> The desired accuracy of the output can be specified by the input
  76. *> parameter ABSTOL.
  77. *>
  78. *> For more details, see ZSTEMR's documentation and:
  79. *> - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representations
  80. *> to compute orthogonal eigenvectors of symmetric tridiagonal matrices,"
  81. *> Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
  82. *> - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors and
  83. *> Relative Gaps," SIAM Journal on Matrix Analysis and Applications, Vol. 25,
  84. *> 2004. Also LAPACK Working Note 154.
  85. *> - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
  86. *> tridiagonal eigenvalue/eigenvector problem",
  87. *> Computer Science Division Technical Report No. UCB/CSD-97-971,
  88. *> UC Berkeley, May 1997.
  89. *>
  90. *>
  91. *> Note 1 : ZHEEVR calls ZSTEMR when the full spectrum is requested
  92. *> on machines which conform to the ieee-754 floating point standard.
  93. *> ZHEEVR calls DSTEBZ and ZSTEIN on non-ieee machines and
  94. *> when partial spectrum requests are made.
  95. *>
  96. *> Normal execution of ZSTEMR may create NaNs and infinities and
  97. *> hence may abort due to a floating point exception in environments
  98. *> which do not handle NaNs and infinities in the ieee standard default
  99. *> manner.
  100. *> \endverbatim
  101. *
  102. * Arguments:
  103. * ==========
  104. *
  105. *> \param[in] JOBZ
  106. *> \verbatim
  107. *> JOBZ is CHARACTER*1
  108. *> = 'N': Compute eigenvalues only;
  109. *> = 'V': Compute eigenvalues and eigenvectors.
  110. *> \endverbatim
  111. *>
  112. *> \param[in] RANGE
  113. *> \verbatim
  114. *> RANGE is CHARACTER*1
  115. *> = 'A': all eigenvalues will be found.
  116. *> = 'V': all eigenvalues in the half-open interval (VL,VU]
  117. *> will be found.
  118. *> = 'I': the IL-th through IU-th eigenvalues will be found.
  119. *> For RANGE = 'V' or 'I' and IU - IL < N - 1, DSTEBZ and
  120. *> ZSTEIN are called
  121. *> \endverbatim
  122. *>
  123. *> \param[in] UPLO
  124. *> \verbatim
  125. *> UPLO is CHARACTER*1
  126. *> = 'U': Upper triangle of A is stored;
  127. *> = 'L': Lower triangle of A is stored.
  128. *> \endverbatim
  129. *>
  130. *> \param[in] N
  131. *> \verbatim
  132. *> N is INTEGER
  133. *> The order of the matrix A. N >= 0.
  134. *> \endverbatim
  135. *>
  136. *> \param[in,out] A
  137. *> \verbatim
  138. *> A is COMPLEX*16 array, dimension (LDA, N)
  139. *> On entry, the Hermitian matrix A. If UPLO = 'U', the
  140. *> leading N-by-N upper triangular part of A contains the
  141. *> upper triangular part of the matrix A. If UPLO = 'L',
  142. *> the leading N-by-N lower triangular part of A contains
  143. *> the lower triangular part of the matrix A.
  144. *> On exit, the lower triangle (if UPLO='L') or the upper
  145. *> triangle (if UPLO='U') of A, including the diagonal, is
  146. *> destroyed.
  147. *> \endverbatim
  148. *>
  149. *> \param[in] LDA
  150. *> \verbatim
  151. *> LDA is INTEGER
  152. *> The leading dimension of the array A. LDA >= max(1,N).
  153. *> \endverbatim
  154. *>
  155. *> \param[in] VL
  156. *> \verbatim
  157. *> VL is DOUBLE PRECISION
  158. *> If RANGE='V', the lower bound of the interval to
  159. *> be searched for eigenvalues. VL < VU.
  160. *> Not referenced if RANGE = 'A' or 'I'.
  161. *> \endverbatim
  162. *>
  163. *> \param[in] VU
  164. *> \verbatim
  165. *> VU is DOUBLE PRECISION
  166. *> If RANGE='V', the upper bound of the interval to
  167. *> be searched for eigenvalues. VL < VU.
  168. *> Not referenced if RANGE = 'A' or 'I'.
  169. *> \endverbatim
  170. *>
  171. *> \param[in] IL
  172. *> \verbatim
  173. *> IL is INTEGER
  174. *> If RANGE='I', the index of the
  175. *> smallest eigenvalue to be returned.
  176. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
  177. *> Not referenced if RANGE = 'A' or 'V'.
  178. *> \endverbatim
  179. *>
  180. *> \param[in] IU
  181. *> \verbatim
  182. *> IU is INTEGER
  183. *> If RANGE='I', the index of the
  184. *> largest eigenvalue to be returned.
  185. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
  186. *> Not referenced if RANGE = 'A' or 'V'.
  187. *> \endverbatim
  188. *>
  189. *> \param[in] ABSTOL
  190. *> \verbatim
  191. *> ABSTOL is DOUBLE PRECISION
  192. *> The absolute error tolerance for the eigenvalues.
  193. *> An approximate eigenvalue is accepted as converged
  194. *> when it is determined to lie in an interval [a,b]
  195. *> of width less than or equal to
  196. *>
  197. *> ABSTOL + EPS * max( |a|,|b| ) ,
  198. *>
  199. *> where EPS is the machine precision. If ABSTOL is less than
  200. *> or equal to zero, then EPS*|T| will be used in its place,
  201. *> where |T| is the 1-norm of the tridiagonal matrix obtained
  202. *> by reducing A to tridiagonal form.
  203. *>
  204. *> See "Computing Small Singular Values of Bidiagonal Matrices
  205. *> with Guaranteed High Relative Accuracy," by Demmel and
  206. *> Kahan, LAPACK Working Note #3.
  207. *>
  208. *> If high relative accuracy is important, set ABSTOL to
  209. *> DLAMCH( 'Safe minimum' ). Doing so will guarantee that
  210. *> eigenvalues are computed to high relative accuracy when
  211. *> possible in future releases. The current code does not
  212. *> make any guarantees about high relative accuracy, but
  213. *> future releases will. See J. Barlow and J. Demmel,
  214. *> "Computing Accurate Eigensystems of Scaled Diagonally
  215. *> Dominant Matrices", LAPACK Working Note #7, for a discussion
  216. *> of which matrices define their eigenvalues to high relative
  217. *> accuracy.
  218. *> \endverbatim
  219. *>
  220. *> \param[out] M
  221. *> \verbatim
  222. *> M is INTEGER
  223. *> The total number of eigenvalues found. 0 <= M <= N.
  224. *> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
  225. *> \endverbatim
  226. *>
  227. *> \param[out] W
  228. *> \verbatim
  229. *> W is DOUBLE PRECISION array, dimension (N)
  230. *> The first M elements contain the selected eigenvalues in
  231. *> ascending order.
  232. *> \endverbatim
  233. *>
  234. *> \param[out] Z
  235. *> \verbatim
  236. *> Z is COMPLEX*16 array, dimension (LDZ, max(1,M))
  237. *> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
  238. *> contain the orthonormal eigenvectors of the matrix A
  239. *> corresponding to the selected eigenvalues, with the i-th
  240. *> column of Z holding the eigenvector associated with W(i).
  241. *> If JOBZ = 'N', then Z is not referenced.
  242. *> Note: the user must ensure that at least max(1,M) columns are
  243. *> supplied in the array Z; if RANGE = 'V', the exact value of M
  244. *> is not known in advance and an upper bound must be used.
  245. *> \endverbatim
  246. *>
  247. *> \param[in] LDZ
  248. *> \verbatim
  249. *> LDZ is INTEGER
  250. *> The leading dimension of the array Z. LDZ >= 1, and if
  251. *> JOBZ = 'V', LDZ >= max(1,N).
  252. *> \endverbatim
  253. *>
  254. *> \param[out] ISUPPZ
  255. *> \verbatim
  256. *> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
  257. *> The support of the eigenvectors in Z, i.e., the indices
  258. *> indicating the nonzero elements in Z. The i-th eigenvector
  259. *> is nonzero only in elements ISUPPZ( 2*i-1 ) through
  260. *> ISUPPZ( 2*i ). This is an output of ZSTEMR (tridiagonal
  261. *> matrix). The support of the eigenvectors of A is typically
  262. *> 1:N because of the unitary transformations applied by ZUNMTR.
  263. *> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
  264. *> \endverbatim
  265. *>
  266. *> \param[out] WORK
  267. *> \verbatim
  268. *> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
  269. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
  270. *> \endverbatim
  271. *>
  272. *> \param[in] LWORK
  273. *> \verbatim
  274. *> LWORK is INTEGER
  275. *> The length of the array WORK.
  276. *> If N <= 1, LWORK >= 1, else LWORK >= 2*N.
  277. *> For optimal efficiency, LWORK >= (NB+1)*N,
  278. *> where NB is the max of the blocksize for ZHETRD and for
  279. *> ZUNMTR as returned by ILAENV.
  280. *>
  281. *> If LWORK = -1, then a workspace query is assumed; the routine
  282. *> only calculates the optimal sizes of the WORK, RWORK and
  283. *> IWORK arrays, returns these values as the first entries of
  284. *> the WORK, RWORK and IWORK arrays, and no error message
  285. *> related to LWORK or LRWORK or LIWORK is issued by XERBLA.
  286. *> \endverbatim
  287. *>
  288. *> \param[out] RWORK
  289. *> \verbatim
  290. *> RWORK is DOUBLE PRECISION array, dimension (MAX(1,LRWORK))
  291. *> On exit, if INFO = 0, RWORK(1) returns the optimal
  292. *> (and minimal) LRWORK.
  293. *> \endverbatim
  294. *>
  295. *> \param[in] LRWORK
  296. *> \verbatim
  297. *> LRWORK is INTEGER
  298. *> The length of the array RWORK.
  299. *> If N <= 1, LRWORK >= 1, else LRWORK >= 24*N.
  300. *>
  301. *> If LRWORK = -1, then a workspace query is assumed; the
  302. *> routine only calculates the optimal sizes of the WORK, RWORK
  303. *> and IWORK arrays, returns these values as the first entries
  304. *> of the WORK, RWORK and IWORK arrays, and no error message
  305. *> related to LWORK or LRWORK or LIWORK is issued by XERBLA.
  306. *> \endverbatim
  307. *>
  308. *> \param[out] IWORK
  309. *> \verbatim
  310. *> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
  311. *> On exit, if INFO = 0, IWORK(1) returns the optimal
  312. *> (and minimal) LIWORK.
  313. *> \endverbatim
  314. *>
  315. *> \param[in] LIWORK
  316. *> \verbatim
  317. *> LIWORK is INTEGER
  318. *> The dimension of the array IWORK.
  319. *> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N.
  320. *>
  321. *> If LIWORK = -1, then a workspace query is assumed; the
  322. *> routine only calculates the optimal sizes of the WORK, RWORK
  323. *> and IWORK arrays, returns these values as the first entries
  324. *> of the WORK, RWORK and IWORK arrays, and no error message
  325. *> related to LWORK or LRWORK or LIWORK is issued by XERBLA.
  326. *> \endverbatim
  327. *>
  328. *> \param[out] INFO
  329. *> \verbatim
  330. *> INFO is INTEGER
  331. *> = 0: successful exit
  332. *> < 0: if INFO = -i, the i-th argument had an illegal value
  333. *> > 0: Internal error
  334. *> \endverbatim
  335. *
  336. * Authors:
  337. * ========
  338. *
  339. *> \author Univ. of Tennessee
  340. *> \author Univ. of California Berkeley
  341. *> \author Univ. of Colorado Denver
  342. *> \author NAG Ltd.
  343. *
  344. *> \ingroup heevr
  345. *
  346. *> \par Contributors:
  347. * ==================
  348. *>
  349. *> Inderjit Dhillon, IBM Almaden, USA \n
  350. *> Osni Marques, LBNL/NERSC, USA \n
  351. *> Ken Stanley, Computer Science Division, University of
  352. *> California at Berkeley, USA \n
  353. *> Jason Riedy, Computer Science Division, University of
  354. *> California at Berkeley, USA \n
  355. *>
  356. * =====================================================================
  357. SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
  358. $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
  359. $ RWORK, LRWORK, IWORK, LIWORK, INFO )
  360. *
  361. * -- LAPACK driver routine --
  362. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  363. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  364. *
  365. * .. Scalar Arguments ..
  366. CHARACTER JOBZ, RANGE, UPLO
  367. INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LRWORK, LWORK,
  368. $ M, N
  369. DOUBLE PRECISION ABSTOL, VL, VU
  370. * ..
  371. * .. Array Arguments ..
  372. INTEGER ISUPPZ( * ), IWORK( * )
  373. DOUBLE PRECISION RWORK( * ), W( * )
  374. COMPLEX*16 A( LDA, * ), WORK( * ), Z( LDZ, * )
  375. * ..
  376. *
  377. * =====================================================================
  378. *
  379. * .. Parameters ..
  380. DOUBLE PRECISION ZERO, ONE, TWO
  381. PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
  382. * ..
  383. * .. Local Scalars ..
  384. LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
  385. $ WANTZ, TRYRAC
  386. CHARACTER ORDER
  387. INTEGER I, IEEEOK, IINFO, IMAX, INDIBL, INDIFL, INDISP,
  388. $ INDIWO, INDRD, INDRDD, INDRE, INDREE, INDRWK,
  389. $ INDTAU, INDWK, INDWKN, ISCALE, ITMP1, J, JJ,
  390. $ LIWMIN, LLWORK, LLRWORK, LLWRKN, LRWMIN,
  391. $ LWKOPT, LWMIN, NB, NSPLIT
  392. DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
  393. $ SIGMA, SMLNUM, TMP1, VLL, VUU
  394. * ..
  395. * .. External Functions ..
  396. LOGICAL LSAME
  397. INTEGER ILAENV
  398. DOUBLE PRECISION DLAMCH, ZLANSY
  399. EXTERNAL LSAME, ILAENV, DLAMCH, ZLANSY
  400. * ..
  401. * .. External Subroutines ..
  402. EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZDSCAL,
  403. $ ZHETRD, ZSTEMR, ZSTEIN, ZSWAP, ZUNMTR
  404. * ..
  405. * .. Intrinsic Functions ..
  406. INTRINSIC DBLE, MAX, MIN, SQRT
  407. * ..
  408. * .. Executable Statements ..
  409. *
  410. * Test the input parameters.
  411. *
  412. IEEEOK = ILAENV( 10, 'ZHEEVR', 'N', 1, 2, 3, 4 )
  413. *
  414. LOWER = LSAME( UPLO, 'L' )
  415. WANTZ = LSAME( JOBZ, 'V' )
  416. ALLEIG = LSAME( RANGE, 'A' )
  417. VALEIG = LSAME( RANGE, 'V' )
  418. INDEIG = LSAME( RANGE, 'I' )
  419. *
  420. LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR.
  421. $ ( LIWORK.EQ.-1 ) )
  422. *
  423. IF( N.LE.1 ) THEN
  424. LWMIN = 1
  425. LRWMIN = 1
  426. LIWMIN = 1
  427. ELSE
  428. LWMIN = 2*N
  429. LRWMIN = 24*N
  430. LIWMIN = 10*N
  431. END IF
  432. *
  433. INFO = 0
  434. IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
  435. INFO = -1
  436. ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
  437. INFO = -2
  438. ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
  439. INFO = -3
  440. ELSE IF( N.LT.0 ) THEN
  441. INFO = -4
  442. ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  443. INFO = -6
  444. ELSE
  445. IF( VALEIG ) THEN
  446. IF( N.GT.0 .AND. VU.LE.VL )
  447. $ INFO = -8
  448. ELSE IF( INDEIG ) THEN
  449. IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
  450. INFO = -9
  451. ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
  452. INFO = -10
  453. END IF
  454. END IF
  455. END IF
  456. IF( INFO.EQ.0 ) THEN
  457. IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
  458. INFO = -15
  459. END IF
  460. END IF
  461. *
  462. IF( INFO.EQ.0 ) THEN
  463. NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 )
  464. NB = MAX( NB, ILAENV( 1, 'ZUNMTR', UPLO, N, -1, -1, -1 ) )
  465. LWKOPT = MAX( ( NB+1 )*N, LWMIN )
  466. WORK( 1 ) = LWKOPT
  467. RWORK( 1 ) = LRWMIN
  468. IWORK( 1 ) = LIWMIN
  469. *
  470. IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
  471. INFO = -18
  472. ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN
  473. INFO = -20
  474. ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
  475. INFO = -22
  476. END IF
  477. END IF
  478. *
  479. IF( INFO.NE.0 ) THEN
  480. CALL XERBLA( 'ZHEEVR', -INFO )
  481. RETURN
  482. ELSE IF( LQUERY ) THEN
  483. RETURN
  484. END IF
  485. *
  486. * Quick return if possible
  487. *
  488. M = 0
  489. IF( N.EQ.0 ) THEN
  490. WORK( 1 ) = 1
  491. RETURN
  492. END IF
  493. *
  494. IF( N.EQ.1 ) THEN
  495. WORK( 1 ) = 1
  496. IF( ALLEIG .OR. INDEIG ) THEN
  497. M = 1
  498. W( 1 ) = DBLE( A( 1, 1 ) )
  499. ELSE
  500. IF( VL.LT.DBLE( A( 1, 1 ) ) .AND. VU.GE.DBLE( A( 1, 1 ) ) )
  501. $ THEN
  502. M = 1
  503. W( 1 ) = DBLE( A( 1, 1 ) )
  504. END IF
  505. END IF
  506. IF( WANTZ ) THEN
  507. Z( 1, 1 ) = ONE
  508. ISUPPZ( 1 ) = 1
  509. ISUPPZ( 2 ) = 1
  510. END IF
  511. RETURN
  512. END IF
  513. *
  514. * Get machine constants.
  515. *
  516. SAFMIN = DLAMCH( 'Safe minimum' )
  517. EPS = DLAMCH( 'Precision' )
  518. SMLNUM = SAFMIN / EPS
  519. BIGNUM = ONE / SMLNUM
  520. RMIN = SQRT( SMLNUM )
  521. RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
  522. *
  523. * Scale matrix to allowable range, if necessary.
  524. *
  525. ISCALE = 0
  526. ABSTLL = ABSTOL
  527. IF (VALEIG) THEN
  528. VLL = VL
  529. VUU = VU
  530. END IF
  531. ANRM = ZLANSY( 'M', UPLO, N, A, LDA, RWORK )
  532. IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
  533. ISCALE = 1
  534. SIGMA = RMIN / ANRM
  535. ELSE IF( ANRM.GT.RMAX ) THEN
  536. ISCALE = 1
  537. SIGMA = RMAX / ANRM
  538. END IF
  539. IF( ISCALE.EQ.1 ) THEN
  540. IF( LOWER ) THEN
  541. DO 10 J = 1, N
  542. CALL ZDSCAL( N-J+1, SIGMA, A( J, J ), 1 )
  543. 10 CONTINUE
  544. ELSE
  545. DO 20 J = 1, N
  546. CALL ZDSCAL( J, SIGMA, A( 1, J ), 1 )
  547. 20 CONTINUE
  548. END IF
  549. IF( ABSTOL.GT.0 )
  550. $ ABSTLL = ABSTOL*SIGMA
  551. IF( VALEIG ) THEN
  552. VLL = VL*SIGMA
  553. VUU = VU*SIGMA
  554. END IF
  555. END IF
  556. * Initialize indices into workspaces. Note: The IWORK indices are
  557. * used only if DSTERF or ZSTEMR fail.
  558. * WORK(INDTAU:INDTAU+N-1) stores the complex scalar factors of the
  559. * elementary reflectors used in ZHETRD.
  560. INDTAU = 1
  561. * INDWK is the starting offset of the remaining complex workspace,
  562. * and LLWORK is the remaining complex workspace size.
  563. INDWK = INDTAU + N
  564. LLWORK = LWORK - INDWK + 1
  565. * RWORK(INDRD:INDRD+N-1) stores the real tridiagonal's diagonal
  566. * entries.
  567. INDRD = 1
  568. * RWORK(INDRE:INDRE+N-1) stores the off-diagonal entries of the
  569. * tridiagonal matrix from ZHETRD.
  570. INDRE = INDRD + N
  571. * RWORK(INDRDD:INDRDD+N-1) is a copy of the diagonal entries over
  572. * -written by ZSTEMR (the DSTERF path copies the diagonal to W).
  573. INDRDD = INDRE + N
  574. * RWORK(INDREE:INDREE+N-1) is a copy of the off-diagonal entries over
  575. * -written while computing the eigenvalues in DSTERF and ZSTEMR.
  576. INDREE = INDRDD + N
  577. * INDRWK is the starting offset of the left-over real workspace, and
  578. * LLRWORK is the remaining workspace size.
  579. INDRWK = INDREE + N
  580. LLRWORK = LRWORK - INDRWK + 1
  581. * IWORK(INDIBL:INDIBL+M-1) corresponds to IBLOCK in DSTEBZ and
  582. * stores the block indices of each of the M<=N eigenvalues.
  583. INDIBL = 1
  584. * IWORK(INDISP:INDISP+NSPLIT-1) corresponds to ISPLIT in DSTEBZ and
  585. * stores the starting and finishing indices of each block.
  586. INDISP = INDIBL + N
  587. * IWORK(INDIFL:INDIFL+N-1) stores the indices of eigenvectors
  588. * that corresponding to eigenvectors that fail to converge in
  589. * DSTEIN. This information is discarded; if any fail, the driver
  590. * returns INFO > 0.
  591. INDIFL = INDISP + N
  592. * INDIWO is the offset of the remaining integer workspace.
  593. INDIWO = INDIFL + N
  594. *
  595. * Call ZHETRD to reduce Hermitian matrix to tridiagonal form.
  596. *
  597. CALL ZHETRD( UPLO, N, A, LDA, RWORK( INDRD ), RWORK( INDRE ),
  598. $ WORK( INDTAU ), WORK( INDWK ), LLWORK, IINFO )
  599. *
  600. * If all eigenvalues are desired
  601. * then call DSTERF or ZSTEMR and ZUNMTR.
  602. *
  603. TEST = .FALSE.
  604. IF( INDEIG ) THEN
  605. IF( IL.EQ.1 .AND. IU.EQ.N ) THEN
  606. TEST = .TRUE.
  607. END IF
  608. END IF
  609. IF( ( ALLEIG.OR.TEST ) .AND. ( IEEEOK.EQ.1 ) ) THEN
  610. IF( .NOT.WANTZ ) THEN
  611. CALL DCOPY( N, RWORK( INDRD ), 1, W, 1 )
  612. CALL DCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 )
  613. CALL DSTERF( N, W, RWORK( INDREE ), INFO )
  614. ELSE
  615. CALL DCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 )
  616. CALL DCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 )
  617. *
  618. IF (ABSTOL .LE. TWO*N*EPS) THEN
  619. TRYRAC = .TRUE.
  620. ELSE
  621. TRYRAC = .FALSE.
  622. END IF
  623. CALL ZSTEMR( JOBZ, 'A', N, RWORK( INDRDD ),
  624. $ RWORK( INDREE ), VL, VU, IL, IU, M, W,
  625. $ Z, LDZ, N, ISUPPZ, TRYRAC,
  626. $ RWORK( INDRWK ), LLRWORK,
  627. $ IWORK, LIWORK, INFO )
  628. *
  629. * Apply unitary matrix used in reduction to tridiagonal
  630. * form to eigenvectors returned by ZSTEMR.
  631. *
  632. IF( WANTZ .AND. INFO.EQ.0 ) THEN
  633. INDWKN = INDWK
  634. LLWRKN = LWORK - INDWKN + 1
  635. CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA,
  636. $ WORK( INDTAU ), Z, LDZ, WORK( INDWKN ),
  637. $ LLWRKN, IINFO )
  638. END IF
  639. END IF
  640. *
  641. *
  642. IF( INFO.EQ.0 ) THEN
  643. M = N
  644. GO TO 30
  645. END IF
  646. INFO = 0
  647. END IF
  648. *
  649. * Otherwise, call DSTEBZ and, if eigenvectors are desired, ZSTEIN.
  650. * Also call DSTEBZ and ZSTEIN if ZSTEMR fails.
  651. *
  652. IF( WANTZ ) THEN
  653. ORDER = 'B'
  654. ELSE
  655. ORDER = 'E'
  656. END IF
  657. CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
  658. $ RWORK( INDRD ), RWORK( INDRE ), M, NSPLIT, W,
  659. $ IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
  660. $ IWORK( INDIWO ), INFO )
  661. *
  662. IF( WANTZ ) THEN
  663. CALL ZSTEIN( N, RWORK( INDRD ), RWORK( INDRE ), M, W,
  664. $ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
  665. $ RWORK( INDRWK ), IWORK( INDIWO ), IWORK( INDIFL ),
  666. $ INFO )
  667. *
  668. * Apply unitary matrix used in reduction to tridiagonal
  669. * form to eigenvectors returned by ZSTEIN.
  670. *
  671. INDWKN = INDWK
  672. LLWRKN = LWORK - INDWKN + 1
  673. CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z,
  674. $ LDZ, WORK( INDWKN ), LLWRKN, IINFO )
  675. END IF
  676. *
  677. * If matrix was scaled, then rescale eigenvalues appropriately.
  678. *
  679. 30 CONTINUE
  680. IF( ISCALE.EQ.1 ) THEN
  681. IF( INFO.EQ.0 ) THEN
  682. IMAX = M
  683. ELSE
  684. IMAX = INFO - 1
  685. END IF
  686. CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
  687. END IF
  688. *
  689. * If eigenvalues are not in order, then sort them, along with
  690. * eigenvectors.
  691. *
  692. IF( WANTZ ) THEN
  693. DO 50 J = 1, M - 1
  694. I = 0
  695. TMP1 = W( J )
  696. DO 40 JJ = J + 1, M
  697. IF( W( JJ ).LT.TMP1 ) THEN
  698. I = JJ
  699. TMP1 = W( JJ )
  700. END IF
  701. 40 CONTINUE
  702. *
  703. IF( I.NE.0 ) THEN
  704. ITMP1 = IWORK( INDIBL+I-1 )
  705. W( I ) = W( J )
  706. IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
  707. W( J ) = TMP1
  708. IWORK( INDIBL+J-1 ) = ITMP1
  709. CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
  710. END IF
  711. 50 CONTINUE
  712. END IF
  713. *
  714. * Set WORK(1) to optimal workspace size.
  715. *
  716. WORK( 1 ) = LWKOPT
  717. RWORK( 1 ) = LRWMIN
  718. IWORK( 1 ) = LIWMIN
  719. *
  720. RETURN
  721. *
  722. * End of ZHEEVR
  723. *
  724. END