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.

dsygv.f 9.5 kB

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