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.

slarrr.f 6.0 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208
  1. *> \brief \b SLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive computations which guarantee high relative accuracy in the eigenvalues.
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download SLARRR + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarrr.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarrr.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarrr.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE SLARRR( N, D, E, INFO )
  22. *
  23. * .. Scalar Arguments ..
  24. * INTEGER N, INFO
  25. * ..
  26. * .. Array Arguments ..
  27. * REAL D( * ), E( * )
  28. * ..
  29. *
  30. *
  31. *
  32. *> \par Purpose:
  33. * =============
  34. *>
  35. *> \verbatim
  36. *>
  37. *> Perform tests to decide whether the symmetric tridiagonal matrix T
  38. *> warrants expensive computations which guarantee high relative accuracy
  39. *> in the eigenvalues.
  40. *> \endverbatim
  41. *
  42. * Arguments:
  43. * ==========
  44. *
  45. *> \param[in] N
  46. *> \verbatim
  47. *> N is INTEGER
  48. *> The order of the matrix. N > 0.
  49. *> \endverbatim
  50. *>
  51. *> \param[in] D
  52. *> \verbatim
  53. *> D is REAL array, dimension (N)
  54. *> The N diagonal elements of the tridiagonal matrix T.
  55. *> \endverbatim
  56. *>
  57. *> \param[in,out] E
  58. *> \verbatim
  59. *> E is REAL array, dimension (N)
  60. *> On entry, the first (N-1) entries contain the subdiagonal
  61. *> elements of the tridiagonal matrix T; E(N) is set to ZERO.
  62. *> \endverbatim
  63. *>
  64. *> \param[out] INFO
  65. *> \verbatim
  66. *> INFO is INTEGER
  67. *> INFO = 0(default) : the matrix warrants computations preserving
  68. *> relative accuracy.
  69. *> INFO = 1 : the matrix warrants computations guaranteeing
  70. *> only absolute accuracy.
  71. *> \endverbatim
  72. *
  73. * Authors:
  74. * ========
  75. *
  76. *> \author Univ. of Tennessee
  77. *> \author Univ. of California Berkeley
  78. *> \author Univ. of Colorado Denver
  79. *> \author NAG Ltd.
  80. *
  81. *> \ingroup OTHERauxiliary
  82. *
  83. *> \par Contributors:
  84. * ==================
  85. *>
  86. *> Beresford Parlett, University of California, Berkeley, USA \n
  87. *> Jim Demmel, University of California, Berkeley, USA \n
  88. *> Inderjit Dhillon, University of Texas, Austin, USA \n
  89. *> Osni Marques, LBNL/NERSC, USA \n
  90. *> Christof Voemel, University of California, Berkeley, USA
  91. *
  92. * =====================================================================
  93. SUBROUTINE SLARRR( N, D, E, INFO )
  94. *
  95. * -- LAPACK auxiliary routine --
  96. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  97. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  98. *
  99. * .. Scalar Arguments ..
  100. INTEGER N, INFO
  101. * ..
  102. * .. Array Arguments ..
  103. REAL D( * ), E( * )
  104. * ..
  105. *
  106. *
  107. * =====================================================================
  108. *
  109. * .. Parameters ..
  110. REAL ZERO, RELCOND
  111. PARAMETER ( ZERO = 0.0E0,
  112. $ RELCOND = 0.999E0 )
  113. * ..
  114. * .. Local Scalars ..
  115. INTEGER I
  116. LOGICAL YESREL
  117. REAL EPS, SAFMIN, SMLNUM, RMIN, TMP, TMP2,
  118. $ OFFDIG, OFFDIG2
  119. * ..
  120. * .. External Functions ..
  121. REAL SLAMCH
  122. EXTERNAL SLAMCH
  123. * ..
  124. * .. Intrinsic Functions ..
  125. INTRINSIC ABS
  126. * ..
  127. * .. Executable Statements ..
  128. *
  129. * Quick return if possible
  130. *
  131. IF( N.LE.0 ) THEN
  132. INFO = 0
  133. RETURN
  134. END IF
  135. *
  136. * As a default, do NOT go for relative-accuracy preserving computations.
  137. INFO = 1
  138. SAFMIN = SLAMCH( 'Safe minimum' )
  139. EPS = SLAMCH( 'Precision' )
  140. SMLNUM = SAFMIN / EPS
  141. RMIN = SQRT( SMLNUM )
  142. * Tests for relative accuracy
  143. *
  144. * Test for scaled diagonal dominance
  145. * Scale the diagonal entries to one and check whether the sum of the
  146. * off-diagonals is less than one
  147. *
  148. * The sdd relative error bounds have a 1/(1- 2*x) factor in them,
  149. * x = max(OFFDIG + OFFDIG2), so when x is close to 1/2, no relative
  150. * accuracy is promised. In the notation of the code fragment below,
  151. * 1/(1 - (OFFDIG + OFFDIG2)) is the condition number.
  152. * We don't think it is worth going into "sdd mode" unless the relative
  153. * condition number is reasonable, not 1/macheps.
  154. * The threshold should be compatible with other thresholds used in the
  155. * code. We set OFFDIG + OFFDIG2 <= .999 =: RELCOND, it corresponds
  156. * to losing at most 3 decimal digits: 1 / (1 - (OFFDIG + OFFDIG2)) <= 1000
  157. * instead of the current OFFDIG + OFFDIG2 < 1
  158. *
  159. YESREL = .TRUE.
  160. OFFDIG = ZERO
  161. TMP = SQRT(ABS(D(1)))
  162. IF (TMP.LT.RMIN) YESREL = .FALSE.
  163. IF(.NOT.YESREL) GOTO 11
  164. DO 10 I = 2, N
  165. TMP2 = SQRT(ABS(D(I)))
  166. IF (TMP2.LT.RMIN) YESREL = .FALSE.
  167. IF(.NOT.YESREL) GOTO 11
  168. OFFDIG2 = ABS(E(I-1))/(TMP*TMP2)
  169. IF(OFFDIG+OFFDIG2.GE.RELCOND) YESREL = .FALSE.
  170. IF(.NOT.YESREL) GOTO 11
  171. TMP = TMP2
  172. OFFDIG = OFFDIG2
  173. 10 CONTINUE
  174. 11 CONTINUE
  175. IF( YESREL ) THEN
  176. INFO = 0
  177. RETURN
  178. ELSE
  179. ENDIF
  180. *
  181. *
  182. * *** MORE TO BE IMPLEMENTED ***
  183. *
  184. *
  185. * Test if the lower bidiagonal matrix L from T = L D L^T
  186. * (zero shift facto) is well conditioned
  187. *
  188. *
  189. * Test if the upper bidiagonal matrix U from T = U D U^T
  190. * (zero shift facto) is well conditioned.
  191. * In this case, the matrix needs to be flipped and, at the end
  192. * of the eigenvector computation, the flip needs to be applied
  193. * to the computed eigenvectors (and the support)
  194. *
  195. *
  196. RETURN
  197. *
  198. * End of SLARRR
  199. *
  200. END