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.

slanst.f 5.3 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186
  1. *> \brief \b SLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric tridiagonal matrix.
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download SLANST + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slanst.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slanst.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slanst.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * REAL FUNCTION SLANST( NORM, N, D, E )
  22. *
  23. * .. Scalar Arguments ..
  24. * CHARACTER NORM
  25. * INTEGER N
  26. * ..
  27. * .. Array Arguments ..
  28. * REAL D( * ), E( * )
  29. * ..
  30. *
  31. *
  32. *> \par Purpose:
  33. * =============
  34. *>
  35. *> \verbatim
  36. *>
  37. *> SLANST returns the value of the one norm, or the Frobenius norm, or
  38. *> the infinity norm, or the element of largest absolute value of a
  39. *> real symmetric tridiagonal matrix A.
  40. *> \endverbatim
  41. *>
  42. *> \return SLANST
  43. *> \verbatim
  44. *>
  45. *> SLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm'
  46. *> (
  47. *> ( norm1(A), NORM = '1', 'O' or 'o'
  48. *> (
  49. *> ( normI(A), NORM = 'I' or 'i'
  50. *> (
  51. *> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
  52. *>
  53. *> where norm1 denotes the one norm of a matrix (maximum column sum),
  54. *> normI denotes the infinity norm of a matrix (maximum row sum) and
  55. *> normF denotes the Frobenius norm of a matrix (square root of sum of
  56. *> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
  57. *> \endverbatim
  58. *
  59. * Arguments:
  60. * ==========
  61. *
  62. *> \param[in] NORM
  63. *> \verbatim
  64. *> NORM is CHARACTER*1
  65. *> Specifies the value to be returned in SLANST as described
  66. *> above.
  67. *> \endverbatim
  68. *>
  69. *> \param[in] N
  70. *> \verbatim
  71. *> N is INTEGER
  72. *> The order of the matrix A. N >= 0. When N = 0, SLANST is
  73. *> set to zero.
  74. *> \endverbatim
  75. *>
  76. *> \param[in] D
  77. *> \verbatim
  78. *> D is REAL array, dimension (N)
  79. *> The diagonal elements of A.
  80. *> \endverbatim
  81. *>
  82. *> \param[in] E
  83. *> \verbatim
  84. *> E is REAL array, dimension (N-1)
  85. *> The (n-1) sub-diagonal or super-diagonal elements of A.
  86. *> \endverbatim
  87. *
  88. * Authors:
  89. * ========
  90. *
  91. *> \author Univ. of Tennessee
  92. *> \author Univ. of California Berkeley
  93. *> \author Univ. of Colorado Denver
  94. *> \author NAG Ltd.
  95. *
  96. *> \date September 2012
  97. *
  98. *> \ingroup auxOTHERauxiliary
  99. *
  100. * =====================================================================
  101. REAL FUNCTION SLANST( NORM, N, D, E )
  102. *
  103. * -- LAPACK auxiliary routine (version 3.4.2) --
  104. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  105. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  106. * September 2012
  107. *
  108. * .. Scalar Arguments ..
  109. CHARACTER NORM
  110. INTEGER N
  111. * ..
  112. * .. Array Arguments ..
  113. REAL D( * ), E( * )
  114. * ..
  115. *
  116. * =====================================================================
  117. *
  118. * .. Parameters ..
  119. REAL ONE, ZERO
  120. PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
  121. * ..
  122. * .. Local Scalars ..
  123. INTEGER I
  124. REAL ANORM, SCALE, SUM
  125. * ..
  126. * .. External Functions ..
  127. LOGICAL LSAME, SISNAN
  128. EXTERNAL LSAME, SISNAN
  129. * ..
  130. * .. External Subroutines ..
  131. EXTERNAL SLASSQ
  132. * ..
  133. * .. Intrinsic Functions ..
  134. INTRINSIC ABS, SQRT
  135. * ..
  136. * .. Executable Statements ..
  137. *
  138. IF( N.LE.0 ) THEN
  139. ANORM = ZERO
  140. ELSE IF( LSAME( NORM, 'M' ) ) THEN
  141. *
  142. * Find max(abs(A(i,j))).
  143. *
  144. ANORM = ABS( D( N ) )
  145. DO 10 I = 1, N - 1
  146. SUM = ABS( D( I ) )
  147. IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM
  148. SUM = ABS( E( I ) )
  149. IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM
  150. 10 CONTINUE
  151. ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' .OR.
  152. $ LSAME( NORM, 'I' ) ) THEN
  153. *
  154. * Find norm1(A).
  155. *
  156. IF( N.EQ.1 ) THEN
  157. ANORM = ABS( D( 1 ) )
  158. ELSE
  159. ANORM = ABS( D( 1 ) )+ABS( E( 1 ) )
  160. SUM = ABS( E( N-1 ) )+ABS( D( N ) )
  161. IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM
  162. DO 20 I = 2, N - 1
  163. SUM = ABS( D( I ) )+ABS( E( I ) )+ABS( E( I-1 ) )
  164. IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM
  165. 20 CONTINUE
  166. END IF
  167. ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
  168. *
  169. * Find normF(A).
  170. *
  171. SCALE = ZERO
  172. SUM = ONE
  173. IF( N.GT.1 ) THEN
  174. CALL SLASSQ( N-1, E, 1, SCALE, SUM )
  175. SUM = 2*SUM
  176. END IF
  177. CALL SLASSQ( N, D, 1, SCALE, SUM )
  178. ANORM = SCALE*SQRT( SUM )
  179. END IF
  180. *
  181. SLANST = ANORM
  182. RETURN
  183. *
  184. * End of SLANST
  185. *
  186. END