Télécharger dlanhs.eso

Retour à la liste

Numérotation des lignes :

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

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