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.

dlange.f 5.8 kB

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