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.

dlarra.f 5.9 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204
  1. *> \brief \b DLARRA computes the splitting points with the specified threshold.
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download DLARRA + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarra.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarra.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarra.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE DLARRA( N, D, E, E2, SPLTOL, TNRM,
  22. * NSPLIT, ISPLIT, INFO )
  23. *
  24. * .. Scalar Arguments ..
  25. * INTEGER INFO, N, NSPLIT
  26. * DOUBLE PRECISION SPLTOL, TNRM
  27. * ..
  28. * .. Array Arguments ..
  29. * INTEGER ISPLIT( * )
  30. * DOUBLE PRECISION D( * ), E( * ), E2( * )
  31. * ..
  32. *
  33. *
  34. *> \par Purpose:
  35. * =============
  36. *>
  37. *> \verbatim
  38. *>
  39. *> Compute the splitting points with threshold SPLTOL.
  40. *> DLARRA sets any "small" off-diagonal elements to zero.
  41. *> \endverbatim
  42. *
  43. * Arguments:
  44. * ==========
  45. *
  46. *> \param[in] N
  47. *> \verbatim
  48. *> N is INTEGER
  49. *> The order of the matrix. N > 0.
  50. *> \endverbatim
  51. *>
  52. *> \param[in] D
  53. *> \verbatim
  54. *> D is DOUBLE PRECISION array, dimension (N)
  55. *> On entry, the N diagonal elements of the tridiagonal
  56. *> matrix T.
  57. *> \endverbatim
  58. *>
  59. *> \param[in,out] E
  60. *> \verbatim
  61. *> E is DOUBLE PRECISION array, dimension (N)
  62. *> On entry, the first (N-1) entries contain the subdiagonal
  63. *> elements of the tridiagonal matrix T; E(N) need not be set.
  64. *> On exit, the entries E( ISPLIT( I ) ), 1 <= I <= NSPLIT,
  65. *> are set to zero, the other entries of E are untouched.
  66. *> \endverbatim
  67. *>
  68. *> \param[in,out] E2
  69. *> \verbatim
  70. *> E2 is DOUBLE PRECISION array, dimension (N)
  71. *> On entry, the first (N-1) entries contain the SQUARES of the
  72. *> subdiagonal elements of the tridiagonal matrix T;
  73. *> E2(N) need not be set.
  74. *> On exit, the entries E2( ISPLIT( I ) ),
  75. *> 1 <= I <= NSPLIT, have been set to zero
  76. *> \endverbatim
  77. *>
  78. *> \param[in] SPLTOL
  79. *> \verbatim
  80. *> SPLTOL is DOUBLE PRECISION
  81. *> The threshold for splitting. Two criteria can be used:
  82. *> SPLTOL<0 : criterion based on absolute off-diagonal value
  83. *> SPLTOL>0 : criterion that preserves relative accuracy
  84. *> \endverbatim
  85. *>
  86. *> \param[in] TNRM
  87. *> \verbatim
  88. *> TNRM is DOUBLE PRECISION
  89. *> The norm of the matrix.
  90. *> \endverbatim
  91. *>
  92. *> \param[out] NSPLIT
  93. *> \verbatim
  94. *> NSPLIT is INTEGER
  95. *> The number of blocks T splits into. 1 <= NSPLIT <= N.
  96. *> \endverbatim
  97. *>
  98. *> \param[out] ISPLIT
  99. *> \verbatim
  100. *> ISPLIT is INTEGER array, dimension (N)
  101. *> The splitting points, at which T breaks up into blocks.
  102. *> The first block consists of rows/columns 1 to ISPLIT(1),
  103. *> the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
  104. *> etc., and the NSPLIT-th consists of rows/columns
  105. *> ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
  106. *> \endverbatim
  107. *>
  108. *> \param[out] INFO
  109. *> \verbatim
  110. *> INFO is INTEGER
  111. *> = 0: successful exit
  112. *> \endverbatim
  113. *
  114. * Authors:
  115. * ========
  116. *
  117. *> \author Univ. of Tennessee
  118. *> \author Univ. of California Berkeley
  119. *> \author Univ. of Colorado Denver
  120. *> \author NAG Ltd.
  121. *
  122. *> \date September 2012
  123. *
  124. *> \ingroup auxOTHERauxiliary
  125. *
  126. *> \par Contributors:
  127. * ==================
  128. *>
  129. *> Beresford Parlett, University of California, Berkeley, USA \n
  130. *> Jim Demmel, University of California, Berkeley, USA \n
  131. *> Inderjit Dhillon, University of Texas, Austin, USA \n
  132. *> Osni Marques, LBNL/NERSC, USA \n
  133. *> Christof Voemel, University of California, Berkeley, USA
  134. *
  135. * =====================================================================
  136. SUBROUTINE DLARRA( N, D, E, E2, SPLTOL, TNRM,
  137. $ NSPLIT, ISPLIT, INFO )
  138. *
  139. * -- LAPACK auxiliary routine (version 3.4.2) --
  140. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  141. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  142. * September 2012
  143. *
  144. * .. Scalar Arguments ..
  145. INTEGER INFO, N, NSPLIT
  146. DOUBLE PRECISION SPLTOL, TNRM
  147. * ..
  148. * .. Array Arguments ..
  149. INTEGER ISPLIT( * )
  150. DOUBLE PRECISION D( * ), E( * ), E2( * )
  151. * ..
  152. *
  153. * =====================================================================
  154. *
  155. * .. Parameters ..
  156. DOUBLE PRECISION ZERO
  157. PARAMETER ( ZERO = 0.0D0 )
  158. * ..
  159. * .. Local Scalars ..
  160. INTEGER I
  161. DOUBLE PRECISION EABS, TMP1
  162. * ..
  163. * .. Intrinsic Functions ..
  164. INTRINSIC ABS
  165. * ..
  166. * .. Executable Statements ..
  167. *
  168. INFO = 0
  169. * Compute splitting points
  170. NSPLIT = 1
  171. IF(SPLTOL.LT.ZERO) THEN
  172. * Criterion based on absolute off-diagonal value
  173. TMP1 = ABS(SPLTOL)* TNRM
  174. DO 9 I = 1, N-1
  175. EABS = ABS( E(I) )
  176. IF( EABS .LE. TMP1) THEN
  177. E(I) = ZERO
  178. E2(I) = ZERO
  179. ISPLIT( NSPLIT ) = I
  180. NSPLIT = NSPLIT + 1
  181. END IF
  182. 9 CONTINUE
  183. ELSE
  184. * Criterion that guarantees relative accuracy
  185. DO 10 I = 1, N-1
  186. EABS = ABS( E(I) )
  187. IF( EABS .LE. SPLTOL * SQRT(ABS(D(I)))*SQRT(ABS(D(I+1))) )
  188. $ THEN
  189. E(I) = ZERO
  190. E2(I) = ZERO
  191. ISPLIT( NSPLIT ) = I
  192. NSPLIT = NSPLIT + 1
  193. END IF
  194. 10 CONTINUE
  195. ENDIF
  196. ISPLIT( NSPLIT ) = N
  197. RETURN
  198. *
  199. * End of DLARRA
  200. *
  201. END