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.

cpteqr.f 7.7 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260
  1. *> \brief \b CPTEQR
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download CPTEQR + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cpteqr.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cpteqr.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cpteqr.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE CPTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
  22. *
  23. * .. Scalar Arguments ..
  24. * CHARACTER COMPZ
  25. * INTEGER INFO, LDZ, N
  26. * ..
  27. * .. Array Arguments ..
  28. * REAL D( * ), E( * ), WORK( * )
  29. * COMPLEX Z( LDZ, * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> CPTEQR computes all eigenvalues and, optionally, eigenvectors of a
  39. *> symmetric positive definite tridiagonal matrix by first factoring the
  40. *> matrix using SPTTRF and then calling CBDSQR to compute the singular
  41. *> values of the bidiagonal factor.
  42. *>
  43. *> This routine computes the eigenvalues of the positive definite
  44. *> tridiagonal matrix to high relative accuracy. This means that if the
  45. *> eigenvalues range over many orders of magnitude in size, then the
  46. *> small eigenvalues and corresponding eigenvectors will be computed
  47. *> more accurately than, for example, with the standard QR method.
  48. *>
  49. *> The eigenvectors of a full or band positive definite Hermitian matrix
  50. *> can also be found if CHETRD, CHPTRD, or CHBTRD has been used to
  51. *> reduce this matrix to tridiagonal form. (The reduction to
  52. *> tridiagonal form, however, may preclude the possibility of obtaining
  53. *> high relative accuracy in the small eigenvalues of the original
  54. *> matrix, if these eigenvalues range over many orders of magnitude.)
  55. *> \endverbatim
  56. *
  57. * Arguments:
  58. * ==========
  59. *
  60. *> \param[in] COMPZ
  61. *> \verbatim
  62. *> COMPZ is CHARACTER*1
  63. *> = 'N': Compute eigenvalues only.
  64. *> = 'V': Compute eigenvectors of original Hermitian
  65. *> matrix also. Array Z contains the unitary matrix
  66. *> used to reduce the original matrix to tridiagonal
  67. *> form.
  68. *> = 'I': Compute eigenvectors of tridiagonal matrix also.
  69. *> \endverbatim
  70. *>
  71. *> \param[in] N
  72. *> \verbatim
  73. *> N is INTEGER
  74. *> The order of the matrix. N >= 0.
  75. *> \endverbatim
  76. *>
  77. *> \param[in,out] D
  78. *> \verbatim
  79. *> D is REAL array, dimension (N)
  80. *> On entry, the n diagonal elements of the tridiagonal matrix.
  81. *> On normal exit, D contains the eigenvalues, in descending
  82. *> order.
  83. *> \endverbatim
  84. *>
  85. *> \param[in,out] E
  86. *> \verbatim
  87. *> E is REAL array, dimension (N-1)
  88. *> On entry, the (n-1) subdiagonal elements of the tridiagonal
  89. *> matrix.
  90. *> On exit, E has been destroyed.
  91. *> \endverbatim
  92. *>
  93. *> \param[in,out] Z
  94. *> \verbatim
  95. *> Z is COMPLEX array, dimension (LDZ, N)
  96. *> On entry, if COMPZ = 'V', the unitary matrix used in the
  97. *> reduction to tridiagonal form.
  98. *> On exit, if COMPZ = 'V', the orthonormal eigenvectors of the
  99. *> original Hermitian matrix;
  100. *> if COMPZ = 'I', the orthonormal eigenvectors of the
  101. *> tridiagonal matrix.
  102. *> If INFO > 0 on exit, Z contains the eigenvectors associated
  103. *> with only the stored eigenvalues.
  104. *> If COMPZ = 'N', then Z is not referenced.
  105. *> \endverbatim
  106. *>
  107. *> \param[in] LDZ
  108. *> \verbatim
  109. *> LDZ is INTEGER
  110. *> The leading dimension of the array Z. LDZ >= 1, and if
  111. *> COMPZ = 'V' or 'I', LDZ >= max(1,N).
  112. *> \endverbatim
  113. *>
  114. *> \param[out] WORK
  115. *> \verbatim
  116. *> WORK is REAL array, dimension (4*N)
  117. *> \endverbatim
  118. *>
  119. *> \param[out] INFO
  120. *> \verbatim
  121. *> INFO is INTEGER
  122. *> = 0: successful exit.
  123. *> < 0: if INFO = -i, the i-th argument had an illegal value.
  124. *> > 0: if INFO = i, and i is:
  125. *> <= N the Cholesky factorization of the matrix could
  126. *> not be performed because the i-th principal minor
  127. *> was not positive definite.
  128. *> > N the SVD algorithm failed to converge;
  129. *> if INFO = N+i, i off-diagonal elements of the
  130. *> bidiagonal factor did not converge to zero.
  131. *> \endverbatim
  132. *
  133. * Authors:
  134. * ========
  135. *
  136. *> \author Univ. of Tennessee
  137. *> \author Univ. of California Berkeley
  138. *> \author Univ. of Colorado Denver
  139. *> \author NAG Ltd.
  140. *
  141. *> \ingroup complexPTcomputational
  142. *
  143. * =====================================================================
  144. SUBROUTINE CPTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
  145. *
  146. * -- LAPACK computational routine --
  147. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  148. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  149. *
  150. * .. Scalar Arguments ..
  151. CHARACTER COMPZ
  152. INTEGER INFO, LDZ, N
  153. * ..
  154. * .. Array Arguments ..
  155. REAL D( * ), E( * ), WORK( * )
  156. COMPLEX Z( LDZ, * )
  157. * ..
  158. *
  159. * ====================================================================
  160. *
  161. * .. Parameters ..
  162. COMPLEX CZERO, CONE
  163. PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ),
  164. $ CONE = ( 1.0E+0, 0.0E+0 ) )
  165. * ..
  166. * .. External Functions ..
  167. LOGICAL LSAME
  168. EXTERNAL LSAME
  169. * ..
  170. * .. External Subroutines ..
  171. EXTERNAL CBDSQR, CLASET, SPTTRF, XERBLA
  172. * ..
  173. * .. Local Arrays ..
  174. COMPLEX C( 1, 1 ), VT( 1, 1 )
  175. * ..
  176. * .. Local Scalars ..
  177. INTEGER I, ICOMPZ, NRU
  178. * ..
  179. * .. Intrinsic Functions ..
  180. INTRINSIC MAX, SQRT
  181. * ..
  182. * .. Executable Statements ..
  183. *
  184. * Test the input parameters.
  185. *
  186. INFO = 0
  187. *
  188. IF( LSAME( COMPZ, 'N' ) ) THEN
  189. ICOMPZ = 0
  190. ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
  191. ICOMPZ = 1
  192. ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
  193. ICOMPZ = 2
  194. ELSE
  195. ICOMPZ = -1
  196. END IF
  197. IF( ICOMPZ.LT.0 ) THEN
  198. INFO = -1
  199. ELSE IF( N.LT.0 ) THEN
  200. INFO = -2
  201. ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1,
  202. $ N ) ) ) THEN
  203. INFO = -6
  204. END IF
  205. IF( INFO.NE.0 ) THEN
  206. CALL XERBLA( 'CPTEQR', -INFO )
  207. RETURN
  208. END IF
  209. *
  210. * Quick return if possible
  211. *
  212. IF( N.EQ.0 )
  213. $ RETURN
  214. *
  215. IF( N.EQ.1 ) THEN
  216. IF( ICOMPZ.GT.0 )
  217. $ Z( 1, 1 ) = CONE
  218. RETURN
  219. END IF
  220. IF( ICOMPZ.EQ.2 )
  221. $ CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDZ )
  222. *
  223. * Call SPTTRF to factor the matrix.
  224. *
  225. CALL SPTTRF( N, D, E, INFO )
  226. IF( INFO.NE.0 )
  227. $ RETURN
  228. DO 10 I = 1, N
  229. D( I ) = SQRT( D( I ) )
  230. 10 CONTINUE
  231. DO 20 I = 1, N - 1
  232. E( I ) = E( I )*D( I )
  233. 20 CONTINUE
  234. *
  235. * Call CBDSQR to compute the singular values/vectors of the
  236. * bidiagonal factor.
  237. *
  238. IF( ICOMPZ.GT.0 ) THEN
  239. NRU = N
  240. ELSE
  241. NRU = 0
  242. END IF
  243. CALL CBDSQR( 'Lower', N, 0, NRU, 0, D, E, VT, 1, Z, LDZ, C, 1,
  244. $ WORK, INFO )
  245. *
  246. * Square the singular values.
  247. *
  248. IF( INFO.EQ.0 ) THEN
  249. DO 30 I = 1, N
  250. D( I ) = D( I )*D( I )
  251. 30 CONTINUE
  252. ELSE
  253. INFO = N + INFO
  254. END IF
  255. *
  256. RETURN
  257. *
  258. * End of CPTEQR
  259. *
  260. END