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.

zpteqr.f 7.8 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263
  1. *> \brief \b ZPTEQR
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download ZPTEQR + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zpteqr.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zpteqr.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zpteqr.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE ZPTEQR( 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. * DOUBLE PRECISION D( * ), E( * ), WORK( * )
  29. * COMPLEX*16 Z( LDZ, * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> ZPTEQR computes all eigenvalues and, optionally, eigenvectors of a
  39. *> symmetric positive definite tridiagonal matrix by first factoring the
  40. *> matrix using DPTTRF and then calling ZBDSQR 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 ZHETRD, ZHPTRD, or ZHBTRD 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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*16 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 DOUBLE PRECISION 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. *> \date December 2016
  142. *
  143. *> \ingroup complex16PTcomputational
  144. *
  145. * =====================================================================
  146. SUBROUTINE ZPTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
  147. *
  148. * -- LAPACK computational routine (version 3.7.0) --
  149. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  150. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  151. * December 2016
  152. *
  153. * .. Scalar Arguments ..
  154. CHARACTER COMPZ
  155. INTEGER INFO, LDZ, N
  156. * ..
  157. * .. Array Arguments ..
  158. DOUBLE PRECISION D( * ), E( * ), WORK( * )
  159. COMPLEX*16 Z( LDZ, * )
  160. * ..
  161. *
  162. * ====================================================================
  163. *
  164. * .. Parameters ..
  165. COMPLEX*16 CZERO, CONE
  166. PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ),
  167. $ CONE = ( 1.0D+0, 0.0D+0 ) )
  168. * ..
  169. * .. External Functions ..
  170. LOGICAL LSAME
  171. EXTERNAL LSAME
  172. * ..
  173. * .. External Subroutines ..
  174. EXTERNAL DPTTRF, XERBLA, ZBDSQR, ZLASET
  175. * ..
  176. * .. Local Arrays ..
  177. COMPLEX*16 C( 1, 1 ), VT( 1, 1 )
  178. * ..
  179. * .. Local Scalars ..
  180. INTEGER I, ICOMPZ, NRU
  181. * ..
  182. * .. Intrinsic Functions ..
  183. INTRINSIC MAX, SQRT
  184. * ..
  185. * .. Executable Statements ..
  186. *
  187. * Test the input parameters.
  188. *
  189. INFO = 0
  190. *
  191. IF( LSAME( COMPZ, 'N' ) ) THEN
  192. ICOMPZ = 0
  193. ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
  194. ICOMPZ = 1
  195. ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
  196. ICOMPZ = 2
  197. ELSE
  198. ICOMPZ = -1
  199. END IF
  200. IF( ICOMPZ.LT.0 ) THEN
  201. INFO = -1
  202. ELSE IF( N.LT.0 ) THEN
  203. INFO = -2
  204. ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1,
  205. $ N ) ) ) THEN
  206. INFO = -6
  207. END IF
  208. IF( INFO.NE.0 ) THEN
  209. CALL XERBLA( 'ZPTEQR', -INFO )
  210. RETURN
  211. END IF
  212. *
  213. * Quick return if possible
  214. *
  215. IF( N.EQ.0 )
  216. $ RETURN
  217. *
  218. IF( N.EQ.1 ) THEN
  219. IF( ICOMPZ.GT.0 )
  220. $ Z( 1, 1 ) = CONE
  221. RETURN
  222. END IF
  223. IF( ICOMPZ.EQ.2 )
  224. $ CALL ZLASET( 'Full', N, N, CZERO, CONE, Z, LDZ )
  225. *
  226. * Call DPTTRF to factor the matrix.
  227. *
  228. CALL DPTTRF( N, D, E, INFO )
  229. IF( INFO.NE.0 )
  230. $ RETURN
  231. DO 10 I = 1, N
  232. D( I ) = SQRT( D( I ) )
  233. 10 CONTINUE
  234. DO 20 I = 1, N - 1
  235. E( I ) = E( I )*D( I )
  236. 20 CONTINUE
  237. *
  238. * Call ZBDSQR to compute the singular values/vectors of the
  239. * bidiagonal factor.
  240. *
  241. IF( ICOMPZ.GT.0 ) THEN
  242. NRU = N
  243. ELSE
  244. NRU = 0
  245. END IF
  246. CALL ZBDSQR( 'Lower', N, 0, NRU, 0, D, E, VT, 1, Z, LDZ, C, 1,
  247. $ WORK, INFO )
  248. *
  249. * Square the singular values.
  250. *
  251. IF( INFO.EQ.0 ) THEN
  252. DO 30 I = 1, N
  253. D( I ) = D( I )*D( I )
  254. 30 CONTINUE
  255. ELSE
  256. INFO = N + INFO
  257. END IF
  258. *
  259. RETURN
  260. *
  261. * End of ZPTEQR
  262. *
  263. END