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.9 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211
  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. *> \date December 2016
  111. *
  112. *> \ingroup doubleGEauxiliary
  113. *
  114. * =====================================================================
  115. DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK )
  116. *
  117. * -- LAPACK auxiliary routine (version 3.7.0) --
  118. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  119. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  120. * December 2016
  121. *
  122. * .. Scalar Arguments ..
  123. CHARACTER NORM
  124. INTEGER LDA, M, N
  125. * ..
  126. * .. Array Arguments ..
  127. DOUBLE PRECISION A( LDA, * ), WORK( * )
  128. * ..
  129. *
  130. * =====================================================================
  131. *
  132. * .. Parameters ..
  133. DOUBLE PRECISION ONE, ZERO
  134. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  135. * ..
  136. * .. Local Scalars ..
  137. INTEGER I, J
  138. DOUBLE PRECISION SCALE, SUM, VALUE, TEMP
  139. * ..
  140. * .. External Subroutines ..
  141. EXTERNAL DLASSQ
  142. * ..
  143. * .. External Functions ..
  144. LOGICAL LSAME, DISNAN
  145. EXTERNAL LSAME, DISNAN
  146. * ..
  147. * .. Intrinsic Functions ..
  148. INTRINSIC ABS, MIN, SQRT
  149. * ..
  150. * .. Executable Statements ..
  151. *
  152. IF( MIN( M, N ).EQ.0 ) THEN
  153. VALUE = ZERO
  154. ELSE IF( LSAME( NORM, 'M' ) ) THEN
  155. *
  156. * Find max(abs(A(i,j))).
  157. *
  158. VALUE = ZERO
  159. DO 20 J = 1, N
  160. DO 10 I = 1, M
  161. TEMP = ABS( A( I, J ) )
  162. IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP
  163. 10 CONTINUE
  164. 20 CONTINUE
  165. ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
  166. *
  167. * Find norm1(A).
  168. *
  169. VALUE = ZERO
  170. DO 40 J = 1, N
  171. SUM = ZERO
  172. DO 30 I = 1, M
  173. SUM = SUM + ABS( A( I, J ) )
  174. 30 CONTINUE
  175. IF( VALUE.LT.SUM .OR. DISNAN( SUM ) ) VALUE = SUM
  176. 40 CONTINUE
  177. ELSE IF( LSAME( NORM, 'I' ) ) THEN
  178. *
  179. * Find normI(A).
  180. *
  181. DO 50 I = 1, M
  182. WORK( I ) = ZERO
  183. 50 CONTINUE
  184. DO 70 J = 1, N
  185. DO 60 I = 1, M
  186. WORK( I ) = WORK( I ) + ABS( A( I, J ) )
  187. 60 CONTINUE
  188. 70 CONTINUE
  189. VALUE = ZERO
  190. DO 80 I = 1, M
  191. TEMP = WORK( I )
  192. IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP
  193. 80 CONTINUE
  194. ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
  195. *
  196. * Find normF(A).
  197. *
  198. SCALE = ZERO
  199. SUM = ONE
  200. DO 90 J = 1, N
  201. CALL DLASSQ( M, A( 1, J ), 1, SCALE, SUM )
  202. 90 CONTINUE
  203. VALUE = SCALE*SQRT( SUM )
  204. END IF
  205. *
  206. DLANGE = VALUE
  207. RETURN
  208. *
  209. * End of DLANGE
  210. *
  211. END