Télécharger dlange.eso

Retour à la liste

Numérotation des lignes :

  1. C DLANGE SOURCE BP208322 15/10/13 21:15:30 8670
  2. *> \brief \b DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general rectangular matrix.
  3. *
  4. * =========== DOCUMENTATION ===========
  5. *
  6. * Online html documentation available at
  7. * http://www.netlib.org/lapack/explore-html/
  8. *
  9. *> \htmlonly
  10. *> Download DLANGE + dependencies
  11. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlange.f">
  12. *> [TGZ]</a>
  13. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlange.f">
  14. *> [ZIP]</a>
  15. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlange.f">
  16. *> [TXT]</a>
  17. *> \endhtmlonly
  18. *
  19. * Definition:
  20. * ===========
  21. *
  22. * REAL*8 FUNCTION DLANGE( NORM, M, N, A, LDA, WORK )
  23. *
  24. * .. Scalar Arguments ..
  25. * CHARACTER NORM
  26. * INTEGER LDA, M, N
  27. * ..
  28. * .. Array Arguments ..
  29. * REAL*8 A( LDA, * ), WORK( * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> DLANGE 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 matrix A.
  41. *> \endverbatim
  42. *>
  43. *> \return DLANGE
  44. *> \verbatim
  45. *>
  46. *> DLANGE = ( 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 DLANGE as described
  67. *> above.
  68. *> \endverbatim
  69. *>
  70. *> \param[in] M
  71. *> \verbatim
  72. *> M is INTEGER
  73. *> The number of rows of the matrix A. M >= 0. When M = 0,
  74. *> DLANGE is set to zero.
  75. *> \endverbatim
  76. *>
  77. *> \param[in] N
  78. *> \verbatim
  79. *> N is INTEGER
  80. *> The number of columns of the matrix A. N >= 0. When N = 0,
  81. *> DLANGE is set to zero.
  82. *> \endverbatim
  83. *>
  84. *> \param[in] A
  85. *> \verbatim
  86. *> A is DOUBLE PRECISION array, dimension (LDA,N)
  87. *> The m by n matrix A.
  88. *> \endverbatim
  89. *>
  90. *> \param[in] LDA
  91. *> \verbatim
  92. *> LDA is INTEGER
  93. *> The leading dimension of the array A. LDA >= max(M,1).
  94. *> \endverbatim
  95. *>
  96. *> \param[out] WORK
  97. *> \verbatim
  98. *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
  99. *> where LWORK >= M when NORM = 'I'; otherwise, WORK is not
  100. *> referenced.
  101. *> \endverbatim
  102. *
  103. * Authors:
  104. * ========
  105. *
  106. *> \author Univ. of Tennessee
  107. *> \author Univ. of California Berkeley
  108. *> \author Univ. of Colorado Denver
  109. *> \author NAG Ltd.
  110. *
  111. *> \date September 2012
  112. *
  113. *> \ingroup doubleGEauxiliary
  114. *
  115. * =====================================================================
  116. FUNCTION DLANGE( NORM, M, N, A, LDA, WORK )
  117. *
  118. * -- LAPACK auxiliary routine (version 3.4.2) --
  119. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  120. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  121. * September 2012
  122. *
  123. * .. Scalar Arguments ..
  124. REAL*8 DLANGE
  125. CHARACTER NORM
  126. INTEGER LDA, M, N
  127. * ..
  128. * .. Array Arguments ..
  129. REAL*8 A( LDA, * ), WORK( * )
  130. * ..
  131. *
  132. * =====================================================================
  133. *
  134. * .. Parameters ..
  135. REAL*8 ONE, ZERO
  136. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  137. * ..
  138. * .. Local Scalars ..
  139. INTEGER I, J
  140. REAL*8 SCALE, SUM, VALUE, TEMP
  141. * ..
  142. * .. External Subroutines ..
  143. EXTERNAL DLASSQ
  144. * ..
  145. * .. External Functions ..
  146. LOGICAL LSAME, DISNAN
  147. EXTERNAL LSAME, DISNAN
  148. * ..
  149. ** .. Intrinsic Functions ..
  150. * INTRINSIC ABS, MIN, SQRT
  151. ** ..
  152. ** .. Executable Statements ..
  153. *
  154. IF( MIN( M, N ).EQ.0 ) THEN
  155. VALUE = ZERO
  156. ELSE IF( LSAME( NORM, 'M' ) ) THEN
  157. *
  158. * Find max(abs(A(i,j))).
  159. *
  160. VALUE = ZERO
  161. DO 20 J = 1, N
  162. DO 10 I = 1, M
  163. TEMP = ABS( A( I, J ) )
  164. IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP
  165. 10 CONTINUE
  166. 20 CONTINUE
  167. ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
  168. *
  169. * Find norm1(A).
  170. *
  171. VALUE = ZERO
  172. DO 40 J = 1, N
  173. SUM = ZERO
  174. DO 30 I = 1, M
  175. SUM = SUM + ABS( A( I, J ) )
  176. 30 CONTINUE
  177. IF( VALUE.LT.SUM .OR. DISNAN( SUM ) ) VALUE = SUM
  178. 40 CONTINUE
  179. ELSE IF( LSAME( NORM, 'I' ) ) THEN
  180. *
  181. * Find normI(A).
  182. *
  183. DO 50 I = 1, M
  184. WORK( I ) = ZERO
  185. 50 CONTINUE
  186. DO 70 J = 1, N
  187. DO 60 I = 1, M
  188. WORK( I ) = WORK( I ) + ABS( A( I, J ) )
  189. 60 CONTINUE
  190. 70 CONTINUE
  191. VALUE = ZERO
  192. DO 80 I = 1, M
  193. TEMP = WORK( I )
  194. IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP
  195. 80 CONTINUE
  196. ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
  197. *
  198. * Find normF(A).
  199. *
  200. SCALE = ZERO
  201. SUM = ONE
  202. DO 90 J = 1, N
  203. CALL DLASSQ( M, A( 1, J ), 1, SCALE, SUM )
  204. 90 CONTINUE
  205. VALUE = SCALE*SQRT( SUM )
  206. END IF
  207. *
  208. DLANGE = VALUE
  209. RETURN
  210. *
  211. * End of DLANGE
  212. *
  213. END
  214.  
  215.  

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