Télécharger dlansy.eso

Retour à la liste

Numérotation des lignes :

dlansy
  1. C DLANSY SOURCE BP208322 22/09/16 21:15:03 11454
  2. *> \brief \b DLANSY 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 matrix.
  3. *
  4. * =========== DOCUMENTATION ===========
  5. *
  6. * Online html documentation available at
  7. * http://www.netlib.org/lapack/explore-html/
  8. *
  9. *> \htmlonly
  10. *> Download DLANSY + dependencies
  11. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlansy.f">
  12. *> [TGZ]</a>
  13. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlansy.f">
  14. *> [ZIP]</a>
  15. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlansy.f">
  16. *> [TXT]</a>
  17. *> \endhtmlonly
  18. *
  19. * Definition:
  20. * ===========
  21. *
  22. * REAL*8 FUNCTION DLANSY( NORM, UPLO, N, A, LDA, WORK )
  23. *
  24. * .. Scalar Arguments ..
  25. * CHARACTER NORM, UPLO
  26. * INTEGER LDA, N
  27. * ..
  28. * .. Array Arguments ..
  29. * REAL*8 A( LDA, * ), WORK( * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> DLANSY returns the value of the one norm, or the Frobenius norm, or
  39. *> the infinity norm, or the element of largest absolute value of a
  40. *> real symmetric matrix A.
  41. *> \endverbatim
  42. *>
  43. *> \return DLANSY
  44. *> \verbatim
  45. *>
  46. *> DLANSY = ( max(abs(A(i,j))), NORM = 'M' or 'm'
  47. *> (
  48. *> ( norm1(A), NORM = '1', 'O' or 'o'
  49. *> (
  50. *> ( normI(A), NORM = 'I' or 'i'
  51. *> (
  52. *> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
  53. *>
  54. *> where norm1 denotes the one norm of a matrix (maximum column sum),
  55. *> normI denotes the infinity norm of a matrix (maximum row sum) and
  56. *> normF denotes the Frobenius norm of a matrix (square root of sum of
  57. *> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
  58. *> \endverbatim
  59. *
  60. * Arguments:
  61. * ==========
  62. *
  63. *> \param[in] NORM
  64. *> \verbatim
  65. *> NORM is CHARACTER*1
  66. *> Specifies the value to be returned in DLANSY as described
  67. *> above.
  68. *> \endverbatim
  69. *>
  70. *> \param[in] UPLO
  71. *> \verbatim
  72. *> UPLO is CHARACTER*1
  73. *> Specifies whether the upper or lower triangular part of the
  74. *> symmetric matrix A is to be referenced.
  75. *> = 'U': Upper triangular part of A is referenced
  76. *> = 'L': Lower triangular part of A is referenced
  77. *> \endverbatim
  78. *>
  79. *> \param[in] N
  80. *> \verbatim
  81. *> N is INTEGER
  82. *> The order of the matrix A. N >= 0. When N = 0, DLANSY is
  83. *> set to zero.
  84. *> \endverbatim
  85. *>
  86. *> \param[in] A
  87. *> \verbatim
  88. *> A is REAL*8 array, dimension (LDA,N)
  89. *> The symmetric matrix A. If UPLO = 'U', the leading n by n
  90. *> upper triangular part of A contains the upper triangular part
  91. *> of the matrix A, and the strictly lower triangular part of A
  92. *> is not referenced. If UPLO = 'L', the leading n by n lower
  93. *> triangular part of A contains the lower triangular part of
  94. *> the matrix A, and the strictly upper triangular part of A is
  95. *> not referenced.
  96. *> \endverbatim
  97. *>
  98. *> \param[in] LDA
  99. *> \verbatim
  100. *> LDA is INTEGER
  101. *> The leading dimension of the array A. LDA >= max(N,1).
  102. *> \endverbatim
  103. *>
  104. *> \param[out] WORK
  105. *> \verbatim
  106. *> WORK is REAL*8 array, dimension (MAX(1,LWORK)),
  107. *> where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
  108. *> WORK is not referenced.
  109. *> \endverbatim
  110. *
  111. * Authors:
  112. * ========
  113. *
  114. *> \author Univ. of Tennessee
  115. *> \author Univ. of California Berkeley
  116. *> \author Univ. of Colorado Denver
  117. *> \author NAG Ltd.
  118. *
  119. *> \ingroup doubleSYauxiliary
  120. *
  121. * =====================================================================
  122. FUNCTION DLANSY( NORM, UPLO, N, A, LDA, WORK )
  123. REAL*8 DLANSY
  124. *
  125. * -- LAPACK auxiliary routine --
  126. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  127. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  128. *
  129. * .. Scalar Arguments ..
  130. CHARACTER NORM, UPLO
  131. INTEGER LDA, N
  132. * ..
  133. * .. Array Arguments ..
  134. REAL*8 A( LDA, * ), WORK( * )
  135. * ..
  136. *
  137. * =====================================================================
  138. *
  139. * .. Parameters ..
  140. REAL*8 ONE, ZERO
  141. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  142. * ..
  143. * .. Local Scalars ..
  144. INTEGER I, J
  145. REAL*8 ABSA, SCALE, SUM, VALUE
  146. * ..
  147. * .. External Subroutines ..
  148. EXTERNAL DLASSQ
  149. * ..
  150. * .. External Functions ..
  151. LOGICAL LSAME, DISNAN
  152. EXTERNAL LSAME, DISNAN
  153. * ..
  154. * .. Intrinsic Functions ..
  155. * INTRINSIC ABS, SQRT
  156. * ..
  157. * .. Executable Statements ..
  158. *
  159. IF( N.EQ.0 ) THEN
  160. VALUE = ZERO
  161. ELSE IF( LSAME( NORM, 'M' ) ) THEN
  162. *
  163. * Find max(abs(A(i,j))).
  164. *
  165. VALUE = ZERO
  166. IF( LSAME( UPLO, 'U' ) ) THEN
  167. DO 20 J = 1, N
  168. DO 10 I = 1, J
  169. SUM = ABS( A( I, J ) )
  170. IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
  171. 10 CONTINUE
  172. 20 CONTINUE
  173. ELSE
  174. DO 40 J = 1, N
  175. DO 30 I = J, N
  176. SUM = ABS( A( I, J ) )
  177. IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
  178. 30 CONTINUE
  179. 40 CONTINUE
  180. END IF
  181. ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
  182. $ ( NORM.EQ.'1' ) ) THEN
  183. *
  184. * Find normI(A) ( = norm1(A), since A is symmetric).
  185. *
  186. VALUE = ZERO
  187. IF( LSAME( UPLO, 'U' ) ) THEN
  188. DO 60 J = 1, N
  189. SUM = ZERO
  190. DO 50 I = 1, J - 1
  191. ABSA = ABS( A( I, J ) )
  192. SUM = SUM + ABSA
  193. WORK( I ) = WORK( I ) + ABSA
  194. 50 CONTINUE
  195. WORK( J ) = SUM + ABS( A( J, J ) )
  196. 60 CONTINUE
  197. DO 70 I = 1, N
  198. SUM = WORK( I )
  199. IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
  200. 70 CONTINUE
  201. ELSE
  202. DO 80 I = 1, N
  203. WORK( I ) = ZERO
  204. 80 CONTINUE
  205. DO 100 J = 1, N
  206. SUM = WORK( J ) + ABS( A( J, J ) )
  207. DO 90 I = J + 1, N
  208. ABSA = ABS( A( I, J ) )
  209. SUM = SUM + ABSA
  210. WORK( I ) = WORK( I ) + ABSA
  211. 90 CONTINUE
  212. IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
  213. 100 CONTINUE
  214. END IF
  215. ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
  216. *
  217. * Find normF(A).
  218. *
  219. SCALE = ZERO
  220. SUM = ONE
  221. IF( LSAME( UPLO, 'U' ) ) THEN
  222. DO 110 J = 2, N
  223. CALL DLASSQ( J-1, A( 1, J ), 1, SCALE, SUM )
  224. 110 CONTINUE
  225. ELSE
  226. DO 120 J = 1, N - 1
  227. CALL DLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM )
  228. 120 CONTINUE
  229. END IF
  230. SUM = 2*SUM
  231. CALL DLASSQ( N, A, LDA+1, SCALE, SUM )
  232. VALUE = SCALE*SQRT( SUM )
  233. END IF
  234. *
  235. DLANSY = VALUE
  236. RETURN
  237. *
  238. * End of DLANSY
  239. *
  240. END
  241.  
  242.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales