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.

chegv.f 9.7 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318
  1. *> \brief \b CHEGV
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download CHEGV + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chegv.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chegv.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chegv.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE CHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK,
  22. * LWORK, RWORK, INFO )
  23. *
  24. * .. Scalar Arguments ..
  25. * CHARACTER JOBZ, UPLO
  26. * INTEGER INFO, ITYPE, LDA, LDB, LWORK, N
  27. * ..
  28. * .. Array Arguments ..
  29. * REAL RWORK( * ), W( * )
  30. * COMPLEX A( LDA, * ), B( LDB, * ), WORK( * )
  31. * ..
  32. *
  33. *
  34. *> \par Purpose:
  35. * =============
  36. *>
  37. *> \verbatim
  38. *>
  39. *> CHEGV computes all the eigenvalues, and optionally, the eigenvectors
  40. *> of a complex generalized Hermitian-definite eigenproblem, of the form
  41. *> A*x=(lambda)*B*x, A*Bx=(lambda)*x, or B*A*x=(lambda)*x.
  42. *> Here A and B are assumed to be Hermitian and B is also
  43. *> positive definite.
  44. *> \endverbatim
  45. *
  46. * Arguments:
  47. * ==========
  48. *
  49. *> \param[in] ITYPE
  50. *> \verbatim
  51. *> ITYPE is INTEGER
  52. *> Specifies the problem type to be solved:
  53. *> = 1: A*x = (lambda)*B*x
  54. *> = 2: A*B*x = (lambda)*x
  55. *> = 3: B*A*x = (lambda)*x
  56. *> \endverbatim
  57. *>
  58. *> \param[in] JOBZ
  59. *> \verbatim
  60. *> JOBZ is CHARACTER*1
  61. *> = 'N': Compute eigenvalues only;
  62. *> = 'V': Compute eigenvalues and eigenvectors.
  63. *> \endverbatim
  64. *>
  65. *> \param[in] UPLO
  66. *> \verbatim
  67. *> UPLO is CHARACTER*1
  68. *> = 'U': Upper triangles of A and B are stored;
  69. *> = 'L': Lower triangles of A and B are stored.
  70. *> \endverbatim
  71. *>
  72. *> \param[in] N
  73. *> \verbatim
  74. *> N is INTEGER
  75. *> The order of the matrices A and B. N >= 0.
  76. *> \endverbatim
  77. *>
  78. *> \param[in,out] A
  79. *> \verbatim
  80. *> A is COMPLEX array, dimension (LDA, N)
  81. *> On entry, the Hermitian matrix A. If UPLO = 'U', the
  82. *> leading N-by-N upper triangular part of A contains the
  83. *> upper triangular part of the matrix A. If UPLO = 'L',
  84. *> the leading N-by-N lower triangular part of A contains
  85. *> the lower triangular part of the matrix A.
  86. *>
  87. *> On exit, if JOBZ = 'V', then if INFO = 0, A contains the
  88. *> matrix Z of eigenvectors. The eigenvectors are normalized
  89. *> as follows:
  90. *> if ITYPE = 1 or 2, Z**H*B*Z = I;
  91. *> if ITYPE = 3, Z**H*inv(B)*Z = I.
  92. *> If JOBZ = 'N', then on exit the upper triangle (if UPLO='U')
  93. *> or the lower triangle (if UPLO='L') of A, including the
  94. *> diagonal, is destroyed.
  95. *> \endverbatim
  96. *>
  97. *> \param[in] LDA
  98. *> \verbatim
  99. *> LDA is INTEGER
  100. *> The leading dimension of the array A. LDA >= max(1,N).
  101. *> \endverbatim
  102. *>
  103. *> \param[in,out] B
  104. *> \verbatim
  105. *> B is COMPLEX array, dimension (LDB, N)
  106. *> On entry, the Hermitian positive definite matrix B.
  107. *> If UPLO = 'U', the leading N-by-N upper triangular part of B
  108. *> contains the upper triangular part of the matrix B.
  109. *> If UPLO = 'L', the leading N-by-N lower triangular part of B
  110. *> contains the lower triangular part of the matrix B.
  111. *>
  112. *> On exit, if INFO <= N, the part of B containing the matrix is
  113. *> overwritten by the triangular factor U or L from the Cholesky
  114. *> factorization B = U**H*U or B = L*L**H.
  115. *> \endverbatim
  116. *>
  117. *> \param[in] LDB
  118. *> \verbatim
  119. *> LDB is INTEGER
  120. *> The leading dimension of the array B. LDB >= max(1,N).
  121. *> \endverbatim
  122. *>
  123. *> \param[out] W
  124. *> \verbatim
  125. *> W is REAL array, dimension (N)
  126. *> If INFO = 0, the eigenvalues in ascending order.
  127. *> \endverbatim
  128. *>
  129. *> \param[out] WORK
  130. *> \verbatim
  131. *> WORK is COMPLEX array, dimension (MAX(1,LWORK))
  132. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
  133. *> \endverbatim
  134. *>
  135. *> \param[in] LWORK
  136. *> \verbatim
  137. *> LWORK is INTEGER
  138. *> The length of the array WORK. LWORK >= max(1,2*N-1).
  139. *> For optimal efficiency, LWORK >= (NB+1)*N,
  140. *> where NB is the blocksize for CHETRD returned by ILAENV.
  141. *>
  142. *> If LWORK = -1, then a workspace query is assumed; the routine
  143. *> only calculates the optimal size of the WORK array, returns
  144. *> this value as the first entry of the WORK array, and no error
  145. *> message related to LWORK is issued by XERBLA.
  146. *> \endverbatim
  147. *>
  148. *> \param[out] RWORK
  149. *> \verbatim
  150. *> RWORK is REAL array, dimension (max(1, 3*N-2))
  151. *> \endverbatim
  152. *>
  153. *> \param[out] INFO
  154. *> \verbatim
  155. *> INFO is INTEGER
  156. *> = 0: successful exit
  157. *> < 0: if INFO = -i, the i-th argument had an illegal value
  158. *> > 0: CPOTRF or CHEEV returned an error code:
  159. *> <= N: if INFO = i, CHEEV failed to converge;
  160. *> i off-diagonal elements of an intermediate
  161. *> tridiagonal form did not converge to zero;
  162. *> > N: if INFO = N + i, for 1 <= i <= N, then the leading
  163. *> minor of order i of B is not positive definite.
  164. *> The factorization of B could not be completed and
  165. *> no eigenvalues or eigenvectors were computed.
  166. *> \endverbatim
  167. *
  168. * Authors:
  169. * ========
  170. *
  171. *> \author Univ. of Tennessee
  172. *> \author Univ. of California Berkeley
  173. *> \author Univ. of Colorado Denver
  174. *> \author NAG Ltd.
  175. *
  176. *> \ingroup complexHEeigen
  177. *
  178. * =====================================================================
  179. SUBROUTINE CHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK,
  180. $ LWORK, RWORK, INFO )
  181. *
  182. * -- LAPACK driver routine --
  183. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  184. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  185. *
  186. * .. Scalar Arguments ..
  187. CHARACTER JOBZ, UPLO
  188. INTEGER INFO, ITYPE, LDA, LDB, LWORK, N
  189. * ..
  190. * .. Array Arguments ..
  191. REAL RWORK( * ), W( * )
  192. COMPLEX A( LDA, * ), B( LDB, * ), WORK( * )
  193. * ..
  194. *
  195. * =====================================================================
  196. *
  197. * .. Parameters ..
  198. COMPLEX ONE
  199. PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
  200. * ..
  201. * .. Local Scalars ..
  202. LOGICAL LQUERY, UPPER, WANTZ
  203. CHARACTER TRANS
  204. INTEGER LWKOPT, NB, NEIG
  205. * ..
  206. * .. External Functions ..
  207. LOGICAL LSAME
  208. INTEGER ILAENV
  209. EXTERNAL ILAENV, LSAME
  210. * ..
  211. * .. External Subroutines ..
  212. EXTERNAL CHEEV, CHEGST, CPOTRF, CTRMM, CTRSM, XERBLA
  213. * ..
  214. * .. Intrinsic Functions ..
  215. INTRINSIC MAX
  216. * ..
  217. * .. Executable Statements ..
  218. *
  219. * Test the input parameters.
  220. *
  221. WANTZ = LSAME( JOBZ, 'V' )
  222. UPPER = LSAME( UPLO, 'U' )
  223. LQUERY = ( LWORK.EQ. -1 )
  224. *
  225. INFO = 0
  226. IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
  227. INFO = -1
  228. ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
  229. INFO = -2
  230. ELSE IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L' ) ) ) THEN
  231. INFO = -3
  232. ELSE IF( N.LT.0 ) THEN
  233. INFO = -4
  234. ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  235. INFO = -6
  236. ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
  237. INFO = -8
  238. END IF
  239. *
  240. IF( INFO.EQ.0 ) THEN
  241. NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 )
  242. LWKOPT = MAX( 1, ( NB + 1 )*N )
  243. WORK( 1 ) = LWKOPT
  244. *
  245. IF( LWORK.LT.MAX( 1, 2*N-1 ) .AND. .NOT.LQUERY ) THEN
  246. INFO = -11
  247. END IF
  248. END IF
  249. *
  250. IF( INFO.NE.0 ) THEN
  251. CALL XERBLA( 'CHEGV ', -INFO )
  252. RETURN
  253. ELSE IF( LQUERY ) THEN
  254. RETURN
  255. END IF
  256. *
  257. * Quick return if possible
  258. *
  259. IF( N.EQ.0 )
  260. $ RETURN
  261. *
  262. * Form a Cholesky factorization of B.
  263. *
  264. CALL CPOTRF( UPLO, N, B, LDB, INFO )
  265. IF( INFO.NE.0 ) THEN
  266. INFO = N + INFO
  267. RETURN
  268. END IF
  269. *
  270. * Transform problem to standard eigenvalue problem and solve.
  271. *
  272. CALL CHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
  273. CALL CHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, INFO )
  274. *
  275. IF( WANTZ ) THEN
  276. *
  277. * Backtransform eigenvectors to the original problem.
  278. *
  279. NEIG = N
  280. IF( INFO.GT.0 )
  281. $ NEIG = INFO - 1
  282. IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
  283. *
  284. * For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
  285. * backtransform eigenvectors: x = inv(L)**H*y or inv(U)*y
  286. *
  287. IF( UPPER ) THEN
  288. TRANS = 'N'
  289. ELSE
  290. TRANS = 'C'
  291. END IF
  292. *
  293. CALL CTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
  294. $ B, LDB, A, LDA )
  295. *
  296. ELSE IF( ITYPE.EQ.3 ) THEN
  297. *
  298. * For B*A*x=(lambda)*x;
  299. * backtransform eigenvectors: x = L*y or U**H*y
  300. *
  301. IF( UPPER ) THEN
  302. TRANS = 'C'
  303. ELSE
  304. TRANS = 'N'
  305. END IF
  306. *
  307. CALL CTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE,
  308. $ B, LDB, A, LDA )
  309. END IF
  310. END IF
  311. *
  312. WORK( 1 ) = LWKOPT
  313. *
  314. RETURN
  315. *
  316. * End of CHEGV
  317. *
  318. END