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.

dptcon.f 5.7 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218
  1. *> \brief \b DPTCON
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download DPTCON + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dptcon.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dptcon.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dptcon.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE DPTCON( N, D, E, ANORM, RCOND, WORK, INFO )
  22. *
  23. * .. Scalar Arguments ..
  24. * INTEGER INFO, N
  25. * DOUBLE PRECISION ANORM, RCOND
  26. * ..
  27. * .. Array Arguments ..
  28. * DOUBLE PRECISION D( * ), E( * ), WORK( * )
  29. * ..
  30. *
  31. *
  32. *> \par Purpose:
  33. * =============
  34. *>
  35. *> \verbatim
  36. *>
  37. *> DPTCON computes the reciprocal of the condition number (in the
  38. *> 1-norm) of a real symmetric positive definite tridiagonal matrix
  39. *> using the factorization A = L*D*L**T or A = U**T*D*U computed by
  40. *> DPTTRF.
  41. *>
  42. *> Norm(inv(A)) is computed by a direct method, and the reciprocal of
  43. *> the condition number is computed as
  44. *> RCOND = 1 / (ANORM * norm(inv(A))).
  45. *> \endverbatim
  46. *
  47. * Arguments:
  48. * ==========
  49. *
  50. *> \param[in] N
  51. *> \verbatim
  52. *> N is INTEGER
  53. *> The order of the matrix A. N >= 0.
  54. *> \endverbatim
  55. *>
  56. *> \param[in] D
  57. *> \verbatim
  58. *> D is DOUBLE PRECISION array, dimension (N)
  59. *> The n diagonal elements of the diagonal matrix D from the
  60. *> factorization of A, as computed by DPTTRF.
  61. *> \endverbatim
  62. *>
  63. *> \param[in] E
  64. *> \verbatim
  65. *> E is DOUBLE PRECISION array, dimension (N-1)
  66. *> The (n-1) off-diagonal elements of the unit bidiagonal factor
  67. *> U or L from the factorization of A, as computed by DPTTRF.
  68. *> \endverbatim
  69. *>
  70. *> \param[in] ANORM
  71. *> \verbatim
  72. *> ANORM is DOUBLE PRECISION
  73. *> The 1-norm of the original matrix A.
  74. *> \endverbatim
  75. *>
  76. *> \param[out] RCOND
  77. *> \verbatim
  78. *> RCOND is DOUBLE PRECISION
  79. *> The reciprocal of the condition number of the matrix A,
  80. *> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is the
  81. *> 1-norm of inv(A) computed in this routine.
  82. *> \endverbatim
  83. *>
  84. *> \param[out] WORK
  85. *> \verbatim
  86. *> WORK is DOUBLE PRECISION array, dimension (N)
  87. *> \endverbatim
  88. *>
  89. *> \param[out] INFO
  90. *> \verbatim
  91. *> INFO is INTEGER
  92. *> = 0: successful exit
  93. *> < 0: if INFO = -i, the i-th argument had an illegal value
  94. *> \endverbatim
  95. *
  96. * Authors:
  97. * ========
  98. *
  99. *> \author Univ. of Tennessee
  100. *> \author Univ. of California Berkeley
  101. *> \author Univ. of Colorado Denver
  102. *> \author NAG Ltd.
  103. *
  104. *> \ingroup doublePTcomputational
  105. *
  106. *> \par Further Details:
  107. * =====================
  108. *>
  109. *> \verbatim
  110. *>
  111. *> The method used is described in Nicholas J. Higham, "Efficient
  112. *> Algorithms for Computing the Condition Number of a Tridiagonal
  113. *> Matrix", SIAM J. Sci. Stat. Comput., Vol. 7, No. 1, January 1986.
  114. *> \endverbatim
  115. *>
  116. * =====================================================================
  117. SUBROUTINE DPTCON( N, D, E, ANORM, RCOND, WORK, INFO )
  118. *
  119. * -- LAPACK computational routine --
  120. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  121. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  122. *
  123. * .. Scalar Arguments ..
  124. INTEGER INFO, N
  125. DOUBLE PRECISION ANORM, RCOND
  126. * ..
  127. * .. Array Arguments ..
  128. DOUBLE PRECISION D( * ), E( * ), WORK( * )
  129. * ..
  130. *
  131. * =====================================================================
  132. *
  133. * .. Parameters ..
  134. DOUBLE PRECISION ONE, ZERO
  135. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  136. * ..
  137. * .. Local Scalars ..
  138. INTEGER I, IX
  139. DOUBLE PRECISION AINVNM
  140. * ..
  141. * .. External Functions ..
  142. INTEGER IDAMAX
  143. EXTERNAL IDAMAX
  144. * ..
  145. * .. External Subroutines ..
  146. EXTERNAL XERBLA
  147. * ..
  148. * .. Intrinsic Functions ..
  149. INTRINSIC ABS
  150. * ..
  151. * .. Executable Statements ..
  152. *
  153. * Test the input arguments.
  154. *
  155. INFO = 0
  156. IF( N.LT.0 ) THEN
  157. INFO = -1
  158. ELSE IF( ANORM.LT.ZERO ) THEN
  159. INFO = -4
  160. END IF
  161. IF( INFO.NE.0 ) THEN
  162. CALL XERBLA( 'DPTCON', -INFO )
  163. RETURN
  164. END IF
  165. *
  166. * Quick return if possible
  167. *
  168. RCOND = ZERO
  169. IF( N.EQ.0 ) THEN
  170. RCOND = ONE
  171. RETURN
  172. ELSE IF( ANORM.EQ.ZERO ) THEN
  173. RETURN
  174. END IF
  175. *
  176. * Check that D(1:N) is positive.
  177. *
  178. DO 10 I = 1, N
  179. IF( D( I ).LE.ZERO )
  180. $ RETURN
  181. 10 CONTINUE
  182. *
  183. * Solve M(A) * x = e, where M(A) = (m(i,j)) is given by
  184. *
  185. * m(i,j) = abs(A(i,j)), i = j,
  186. * m(i,j) = -abs(A(i,j)), i .ne. j,
  187. *
  188. * and e = [ 1, 1, ..., 1 ]**T. Note M(A) = M(L)*D*M(L)**T.
  189. *
  190. * Solve M(L) * x = e.
  191. *
  192. WORK( 1 ) = ONE
  193. DO 20 I = 2, N
  194. WORK( I ) = ONE + WORK( I-1 )*ABS( E( I-1 ) )
  195. 20 CONTINUE
  196. *
  197. * Solve D * M(L)**T * x = b.
  198. *
  199. WORK( N ) = WORK( N ) / D( N )
  200. DO 30 I = N - 1, 1, -1
  201. WORK( I ) = WORK( I ) / D( I ) + WORK( I+1 )*ABS( E( I ) )
  202. 30 CONTINUE
  203. *
  204. * Compute AINVNM = max(x(i)), 1<=i<=n.
  205. *
  206. IX = IDAMAX( N, WORK, 1 )
  207. AINVNM = ABS( WORK( IX ) )
  208. *
  209. * Compute the reciprocal condition number.
  210. *
  211. IF( AINVNM.NE.ZERO )
  212. $ RCOND = ( ONE / AINVNM ) / ANORM
  213. *
  214. RETURN
  215. *
  216. * End of DPTCON
  217. *
  218. END