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.

zlanhs.f 5.8 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207
  1. *> \brief \b ZLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of an upper Hessenberg matrix.
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download ZLANHS + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlanhs.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlanhs.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlanhs.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * DOUBLE PRECISION FUNCTION ZLANHS( NORM, N, A, LDA, WORK )
  22. *
  23. * .. Scalar Arguments ..
  24. * CHARACTER NORM
  25. * INTEGER LDA, N
  26. * ..
  27. * .. Array Arguments ..
  28. * DOUBLE PRECISION WORK( * )
  29. * COMPLEX*16 A( LDA, * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> ZLANHS 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 ZLANHS
  44. *> \verbatim
  45. *>
  46. *> ZLANHS = ( 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 ZLANHS 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, ZLANHS is
  74. *> set to zero.
  75. *> \endverbatim
  76. *>
  77. *> \param[in] A
  78. *> \verbatim
  79. *> A is COMPLEX*16 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 complex16OTHERauxiliary
  108. *
  109. * =====================================================================
  110. DOUBLE PRECISION FUNCTION ZLANHS( 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. CHARACTER NORM
  119. INTEGER LDA, N
  120. * ..
  121. * .. Array Arguments ..
  122. DOUBLE PRECISION WORK( * )
  123. COMPLEX*16 A( LDA, * )
  124. * ..
  125. *
  126. * =====================================================================
  127. *
  128. * .. Parameters ..
  129. DOUBLE PRECISION ONE, ZERO
  130. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  131. * ..
  132. * .. Local Scalars ..
  133. INTEGER I, J
  134. DOUBLE PRECISION SCALE, SUM, VALUE
  135. * ..
  136. * .. External Functions ..
  137. LOGICAL LSAME, DISNAN
  138. EXTERNAL LSAME, DISNAN
  139. * ..
  140. * .. External Subroutines ..
  141. EXTERNAL ZLASSQ
  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 ZLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM )
  198. 90 CONTINUE
  199. VALUE = SCALE*SQRT( SUM )
  200. END IF
  201. *
  202. ZLANHS = VALUE
  203. RETURN
  204. *
  205. * End of ZLANHS
  206. *
  207. END