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.

chegvx.f 15 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474
  1. *> \brief \b CHEGVX
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download CHEGVX + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chegvx.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chegvx.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chegvx.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE CHEGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB,
  22. * VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
  23. * LWORK, RWORK, IWORK, IFAIL, INFO )
  24. *
  25. * .. Scalar Arguments ..
  26. * CHARACTER JOBZ, RANGE, UPLO
  27. * INTEGER IL, INFO, ITYPE, IU, LDA, LDB, LDZ, LWORK, M, N
  28. * REAL ABSTOL, VL, VU
  29. * ..
  30. * .. Array Arguments ..
  31. * INTEGER IFAIL( * ), IWORK( * )
  32. * REAL RWORK( * ), W( * )
  33. * COMPLEX A( LDA, * ), B( LDB, * ), WORK( * ),
  34. * $ Z( LDZ, * )
  35. * ..
  36. *
  37. *
  38. *> \par Purpose:
  39. * =============
  40. *>
  41. *> \verbatim
  42. *>
  43. *> CHEGVX computes selected eigenvalues, and optionally, eigenvectors
  44. *> of a complex generalized Hermitian-definite eigenproblem, of the form
  45. *> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x. Here A and
  46. *> B are assumed to be Hermitian and B is also positive definite.
  47. *> Eigenvalues and eigenvectors can be selected by specifying either a
  48. *> range of values or a range of indices for the desired eigenvalues.
  49. *> \endverbatim
  50. *
  51. * Arguments:
  52. * ==========
  53. *
  54. *> \param[in] ITYPE
  55. *> \verbatim
  56. *> ITYPE is INTEGER
  57. *> Specifies the problem type to be solved:
  58. *> = 1: A*x = (lambda)*B*x
  59. *> = 2: A*B*x = (lambda)*x
  60. *> = 3: B*A*x = (lambda)*x
  61. *> \endverbatim
  62. *>
  63. *> \param[in] JOBZ
  64. *> \verbatim
  65. *> JOBZ is CHARACTER*1
  66. *> = 'N': Compute eigenvalues only;
  67. *> = 'V': Compute eigenvalues and eigenvectors.
  68. *> \endverbatim
  69. *>
  70. *> \param[in] RANGE
  71. *> \verbatim
  72. *> RANGE is CHARACTER*1
  73. *> = 'A': all eigenvalues will be found.
  74. *> = 'V': all eigenvalues in the half-open interval (VL,VU]
  75. *> will be found.
  76. *> = 'I': the IL-th through IU-th eigenvalues will be found.
  77. *> \endverbatim
  78. *>
  79. *> \param[in] UPLO
  80. *> \verbatim
  81. *> UPLO is CHARACTER*1
  82. *> = 'U': Upper triangles of A and B are stored;
  83. *> = 'L': Lower triangles of A and B are stored.
  84. *> \endverbatim
  85. *>
  86. *> \param[in] N
  87. *> \verbatim
  88. *> N is INTEGER
  89. *> The order of the matrices A and B. N >= 0.
  90. *> \endverbatim
  91. *>
  92. *> \param[in,out] A
  93. *> \verbatim
  94. *> A is COMPLEX array, dimension (LDA, N)
  95. *> On entry, the Hermitian matrix A. If UPLO = 'U', the
  96. *> leading N-by-N upper triangular part of A contains the
  97. *> upper triangular part of the matrix A. If UPLO = 'L',
  98. *> the leading N-by-N lower triangular part of A contains
  99. *> the lower triangular part of the matrix A.
  100. *>
  101. *> On exit, the lower triangle (if UPLO='L') or the upper
  102. *> triangle (if UPLO='U') of A, including the diagonal, is
  103. *> destroyed.
  104. *> \endverbatim
  105. *>
  106. *> \param[in] LDA
  107. *> \verbatim
  108. *> LDA is INTEGER
  109. *> The leading dimension of the array A. LDA >= max(1,N).
  110. *> \endverbatim
  111. *>
  112. *> \param[in,out] B
  113. *> \verbatim
  114. *> B is COMPLEX array, dimension (LDB, N)
  115. *> On entry, the Hermitian matrix B. If UPLO = 'U', the
  116. *> leading N-by-N upper triangular part of B contains the
  117. *> upper triangular part of the matrix B. If UPLO = 'L',
  118. *> the leading N-by-N lower triangular part of B contains
  119. *> the lower triangular part of the matrix B.
  120. *>
  121. *> On exit, if INFO <= N, the part of B containing the matrix is
  122. *> overwritten by the triangular factor U or L from the Cholesky
  123. *> factorization B = U**H*U or B = L*L**H.
  124. *> \endverbatim
  125. *>
  126. *> \param[in] LDB
  127. *> \verbatim
  128. *> LDB is INTEGER
  129. *> The leading dimension of the array B. LDB >= max(1,N).
  130. *> \endverbatim
  131. *>
  132. *> \param[in] VL
  133. *> \verbatim
  134. *> VL is REAL
  135. *>
  136. *> If RANGE='V', the lower bound of the interval to
  137. *> be searched for eigenvalues. VL < VU.
  138. *> Not referenced if RANGE = 'A' or 'I'.
  139. *> \endverbatim
  140. *>
  141. *> \param[in] VU
  142. *> \verbatim
  143. *> VU is REAL
  144. *>
  145. *> If RANGE='V', the upper bound of the interval to
  146. *> be searched for eigenvalues. VL < VU.
  147. *> Not referenced if RANGE = 'A' or 'I'.
  148. *> \endverbatim
  149. *>
  150. *> \param[in] IL
  151. *> \verbatim
  152. *> IL is INTEGER
  153. *>
  154. *> If RANGE='I', the index of the
  155. *> smallest eigenvalue to be returned.
  156. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
  157. *> Not referenced if RANGE = 'A' or 'V'.
  158. *> \endverbatim
  159. *>
  160. *> \param[in] IU
  161. *> \verbatim
  162. *> IU is INTEGER
  163. *>
  164. *> If RANGE='I', the index of the
  165. *> largest eigenvalue to be returned.
  166. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
  167. *> Not referenced if RANGE = 'A' or 'V'.
  168. *> \endverbatim
  169. *>
  170. *> \param[in] ABSTOL
  171. *> \verbatim
  172. *> ABSTOL is REAL
  173. *> The absolute error tolerance for the eigenvalues.
  174. *> An approximate eigenvalue is accepted as converged
  175. *> when it is determined to lie in an interval [a,b]
  176. *> of width less than or equal to
  177. *>
  178. *> ABSTOL + EPS * max( |a|,|b| ) ,
  179. *>
  180. *> where EPS is the machine precision. If ABSTOL is less than
  181. *> or equal to zero, then EPS*|T| will be used in its place,
  182. *> where |T| is the 1-norm of the tridiagonal matrix obtained
  183. *> by reducing C to tridiagonal form, where C is the symmetric
  184. *> matrix of the standard symmetric problem to which the
  185. *> generalized problem is transformed.
  186. *>
  187. *> Eigenvalues will be computed most accurately when ABSTOL is
  188. *> set to twice the underflow threshold 2*SLAMCH('S'), not zero.
  189. *> If this routine returns with INFO>0, indicating that some
  190. *> eigenvectors did not converge, try setting ABSTOL to
  191. *> 2*SLAMCH('S').
  192. *> \endverbatim
  193. *>
  194. *> \param[out] M
  195. *> \verbatim
  196. *> M is INTEGER
  197. *> The total number of eigenvalues found. 0 <= M <= N.
  198. *> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
  199. *> \endverbatim
  200. *>
  201. *> \param[out] W
  202. *> \verbatim
  203. *> W is REAL array, dimension (N)
  204. *> The first M elements contain the selected
  205. *> eigenvalues in ascending order.
  206. *> \endverbatim
  207. *>
  208. *> \param[out] Z
  209. *> \verbatim
  210. *> Z is COMPLEX array, dimension (LDZ, max(1,M))
  211. *> If JOBZ = 'N', then Z is not referenced.
  212. *> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
  213. *> contain the orthonormal eigenvectors of the matrix A
  214. *> corresponding to the selected eigenvalues, with the i-th
  215. *> column of Z holding the eigenvector associated with W(i).
  216. *> The eigenvectors are normalized as follows:
  217. *> if ITYPE = 1 or 2, Z**T*B*Z = I;
  218. *> if ITYPE = 3, Z**T*inv(B)*Z = I.
  219. *>
  220. *> If an eigenvector fails to converge, then that column of Z
  221. *> contains the latest approximation to the eigenvector, and the
  222. *> index of the eigenvector is returned in IFAIL.
  223. *> Note: the user must ensure that at least max(1,M) columns are
  224. *> supplied in the array Z; if RANGE = 'V', the exact value of M
  225. *> is not known in advance and an upper bound must be used.
  226. *> \endverbatim
  227. *>
  228. *> \param[in] LDZ
  229. *> \verbatim
  230. *> LDZ is INTEGER
  231. *> The leading dimension of the array Z. LDZ >= 1, and if
  232. *> JOBZ = 'V', LDZ >= max(1,N).
  233. *> \endverbatim
  234. *>
  235. *> \param[out] WORK
  236. *> \verbatim
  237. *> WORK is COMPLEX array, dimension (MAX(1,LWORK))
  238. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
  239. *> \endverbatim
  240. *>
  241. *> \param[in] LWORK
  242. *> \verbatim
  243. *> LWORK is INTEGER
  244. *> The length of the array WORK. LWORK >= max(1,2*N).
  245. *> For optimal efficiency, LWORK >= (NB+1)*N,
  246. *> where NB is the blocksize for CHETRD returned by ILAENV.
  247. *>
  248. *> If LWORK = -1, then a workspace query is assumed; the routine
  249. *> only calculates the optimal size of the WORK array, returns
  250. *> this value as the first entry of the WORK array, and no error
  251. *> message related to LWORK is issued by XERBLA.
  252. *> \endverbatim
  253. *>
  254. *> \param[out] RWORK
  255. *> \verbatim
  256. *> RWORK is REAL array, dimension (7*N)
  257. *> \endverbatim
  258. *>
  259. *> \param[out] IWORK
  260. *> \verbatim
  261. *> IWORK is INTEGER array, dimension (5*N)
  262. *> \endverbatim
  263. *>
  264. *> \param[out] IFAIL
  265. *> \verbatim
  266. *> IFAIL is INTEGER array, dimension (N)
  267. *> If JOBZ = 'V', then if INFO = 0, the first M elements of
  268. *> IFAIL are zero. If INFO > 0, then IFAIL contains the
  269. *> indices of the eigenvectors that failed to converge.
  270. *> If JOBZ = 'N', then IFAIL is not referenced.
  271. *> \endverbatim
  272. *>
  273. *> \param[out] INFO
  274. *> \verbatim
  275. *> INFO is INTEGER
  276. *> = 0: successful exit
  277. *> < 0: if INFO = -i, the i-th argument had an illegal value
  278. *> > 0: CPOTRF or CHEEVX returned an error code:
  279. *> <= N: if INFO = i, CHEEVX failed to converge;
  280. *> i eigenvectors failed to converge. Their indices
  281. *> are stored in array IFAIL.
  282. *> > N: if INFO = N + i, for 1 <= i <= N, then the leading
  283. *> principal minor of order i of B is not positive.
  284. *> The factorization of B could not be completed and
  285. *> no eigenvalues or eigenvectors were computed.
  286. *> \endverbatim
  287. *
  288. * Authors:
  289. * ========
  290. *
  291. *> \author Univ. of Tennessee
  292. *> \author Univ. of California Berkeley
  293. *> \author Univ. of Colorado Denver
  294. *> \author NAG Ltd.
  295. *
  296. *> \ingroup hegvx
  297. *
  298. *> \par Contributors:
  299. * ==================
  300. *>
  301. *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
  302. *
  303. * =====================================================================
  304. SUBROUTINE CHEGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB,
  305. $ VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
  306. $ LWORK, RWORK, IWORK, IFAIL, INFO )
  307. *
  308. * -- LAPACK driver routine --
  309. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  310. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  311. *
  312. * .. Scalar Arguments ..
  313. CHARACTER JOBZ, RANGE, UPLO
  314. INTEGER IL, INFO, ITYPE, IU, LDA, LDB, LDZ, LWORK, M, N
  315. REAL ABSTOL, VL, VU
  316. * ..
  317. * .. Array Arguments ..
  318. INTEGER IFAIL( * ), IWORK( * )
  319. REAL RWORK( * ), W( * )
  320. COMPLEX A( LDA, * ), B( LDB, * ), WORK( * ),
  321. $ Z( LDZ, * )
  322. * ..
  323. *
  324. * =====================================================================
  325. *
  326. * .. Parameters ..
  327. COMPLEX CONE
  328. PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ) )
  329. * ..
  330. * .. Local Scalars ..
  331. LOGICAL ALLEIG, INDEIG, LQUERY, UPPER, VALEIG, WANTZ
  332. CHARACTER TRANS
  333. INTEGER LWKOPT, NB
  334. * ..
  335. * .. External Functions ..
  336. LOGICAL LSAME
  337. INTEGER ILAENV
  338. REAL SROUNDUP_LWORK
  339. EXTERNAL ILAENV, LSAME, SROUNDUP_LWORK
  340. * ..
  341. * .. External Subroutines ..
  342. EXTERNAL CHEEVX, CHEGST, CPOTRF, CTRMM, CTRSM, XERBLA
  343. * ..
  344. * .. Intrinsic Functions ..
  345. INTRINSIC MAX, MIN
  346. * ..
  347. * .. Executable Statements ..
  348. *
  349. * Test the input parameters.
  350. *
  351. WANTZ = LSAME( JOBZ, 'V' )
  352. UPPER = LSAME( UPLO, 'U' )
  353. ALLEIG = LSAME( RANGE, 'A' )
  354. VALEIG = LSAME( RANGE, 'V' )
  355. INDEIG = LSAME( RANGE, 'I' )
  356. LQUERY = ( LWORK.EQ.-1 )
  357. *
  358. INFO = 0
  359. IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
  360. INFO = -1
  361. ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
  362. INFO = -2
  363. ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
  364. INFO = -3
  365. ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
  366. INFO = -4
  367. ELSE IF( N.LT.0 ) THEN
  368. INFO = -5
  369. ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  370. INFO = -7
  371. ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
  372. INFO = -9
  373. ELSE
  374. IF( VALEIG ) THEN
  375. IF( N.GT.0 .AND. VU.LE.VL )
  376. $ INFO = -11
  377. ELSE IF( INDEIG ) THEN
  378. IF( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) THEN
  379. INFO = -12
  380. ELSE IF( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) THEN
  381. INFO = -13
  382. END IF
  383. END IF
  384. END IF
  385. IF (INFO.EQ.0) THEN
  386. IF (LDZ.LT.1 .OR. (WANTZ .AND. LDZ.LT.N)) THEN
  387. INFO = -18
  388. END IF
  389. END IF
  390. *
  391. IF( INFO.EQ.0 ) THEN
  392. NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 )
  393. LWKOPT = MAX( 1, ( NB + 1 )*N )
  394. WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
  395. *
  396. IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN
  397. INFO = -20
  398. END IF
  399. END IF
  400. *
  401. IF( INFO.NE.0 ) THEN
  402. CALL XERBLA( 'CHEGVX', -INFO )
  403. RETURN
  404. ELSE IF( LQUERY ) THEN
  405. RETURN
  406. END IF
  407. *
  408. * Quick return if possible
  409. *
  410. M = 0
  411. IF( N.EQ.0 ) THEN
  412. RETURN
  413. END IF
  414. *
  415. * Form a Cholesky factorization of B.
  416. *
  417. CALL CPOTRF( UPLO, N, B, LDB, INFO )
  418. IF( INFO.NE.0 ) THEN
  419. INFO = N + INFO
  420. RETURN
  421. END IF
  422. *
  423. * Transform problem to standard eigenvalue problem and solve.
  424. *
  425. CALL CHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
  426. CALL CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL,
  427. $ M, W, Z, LDZ, WORK, LWORK, RWORK, IWORK, IFAIL,
  428. $ INFO )
  429. *
  430. IF( WANTZ ) THEN
  431. *
  432. * Backtransform eigenvectors to the original problem.
  433. *
  434. IF( INFO.GT.0 )
  435. $ M = INFO - 1
  436. IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
  437. *
  438. * For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
  439. * backtransform eigenvectors: x = inv(L)**H*y or inv(U)*y
  440. *
  441. IF( UPPER ) THEN
  442. TRANS = 'N'
  443. ELSE
  444. TRANS = 'C'
  445. END IF
  446. *
  447. CALL CTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, M, CONE, B,
  448. $ LDB, Z, LDZ )
  449. *
  450. ELSE IF( ITYPE.EQ.3 ) THEN
  451. *
  452. * For B*A*x=(lambda)*x;
  453. * backtransform eigenvectors: x = L*y or U**H*y
  454. *
  455. IF( UPPER ) THEN
  456. TRANS = 'C'
  457. ELSE
  458. TRANS = 'N'
  459. END IF
  460. *
  461. CALL CTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, M, CONE, B,
  462. $ LDB, Z, LDZ )
  463. END IF
  464. END IF
  465. *
  466. * Set WORK(1) to optimal complex workspace size.
  467. *
  468. WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
  469. *
  470. RETURN
  471. *
  472. * End of CHEGVX
  473. *
  474. END