![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlanhs.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack|
Return to dlanhs.f CVS log | Up to [local] / rpl / lapack / lapack |
1.1 bertrand 1: DOUBLE PRECISION FUNCTION DLANHS( NORM, N, A, LDA, WORK )
2: *
3: * -- LAPACK auxiliary routine (version 3.2) --
4: * -- LAPACK is a software package provided by Univ. of Tennessee, --
5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6: * November 2006
7: *
8: * .. Scalar Arguments ..
9: CHARACTER NORM
10: INTEGER LDA, N
11: * ..
12: * .. Array Arguments ..
13: DOUBLE PRECISION A( LDA, * ), WORK( * )
14: * ..
15: *
16: * Purpose
17: * =======
18: *
19: * DLANHS returns the value of the one norm, or the Frobenius norm, or
20: * the infinity norm, or the element of largest absolute value of a
21: * Hessenberg matrix A.
22: *
23: * Description
24: * ===========
25: *
26: * DLANHS returns the value
27: *
28: * DLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
29: * (
30: * ( norm1(A), NORM = '1', 'O' or 'o'
31: * (
32: * ( normI(A), NORM = 'I' or 'i'
33: * (
34: * ( normF(A), NORM = 'F', 'f', 'E' or 'e'
35: *
36: * where norm1 denotes the one norm of a matrix (maximum column sum),
37: * normI denotes the infinity norm of a matrix (maximum row sum) and
38: * normF denotes the Frobenius norm of a matrix (square root of sum of
39: * squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
40: *
41: * Arguments
42: * =========
43: *
44: * NORM (input) CHARACTER*1
45: * Specifies the value to be returned in DLANHS as described
46: * above.
47: *
48: * N (input) INTEGER
49: * The order of the matrix A. N >= 0. When N = 0, DLANHS is
50: * set to zero.
51: *
52: * A (input) DOUBLE PRECISION array, dimension (LDA,N)
53: * The n by n upper Hessenberg matrix A; the part of A below the
54: * first sub-diagonal is not referenced.
55: *
56: * LDA (input) INTEGER
57: * The leading dimension of the array A. LDA >= max(N,1).
58: *
59: * WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
60: * where LWORK >= N when NORM = 'I'; otherwise, WORK is not
61: * referenced.
62: *
63: * =====================================================================
64: *
65: * .. Parameters ..
66: DOUBLE PRECISION ONE, ZERO
67: PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
68: * ..
69: * .. Local Scalars ..
70: INTEGER I, J
71: DOUBLE PRECISION SCALE, SUM, VALUE
72: * ..
73: * .. External Subroutines ..
74: EXTERNAL DLASSQ
75: * ..
76: * .. External Functions ..
77: LOGICAL LSAME
78: EXTERNAL LSAME
79: * ..
80: * .. Intrinsic Functions ..
81: INTRINSIC ABS, MAX, MIN, SQRT
82: * ..
83: * .. Executable Statements ..
84: *
85: IF( N.EQ.0 ) THEN
86: VALUE = ZERO
87: ELSE IF( LSAME( NORM, 'M' ) ) THEN
88: *
89: * Find max(abs(A(i,j))).
90: *
91: VALUE = ZERO
92: DO 20 J = 1, N
93: DO 10 I = 1, MIN( N, J+1 )
94: VALUE = MAX( VALUE, ABS( A( I, J ) ) )
95: 10 CONTINUE
96: 20 CONTINUE
97: ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
98: *
99: * Find norm1(A).
100: *
101: VALUE = ZERO
102: DO 40 J = 1, N
103: SUM = ZERO
104: DO 30 I = 1, MIN( N, J+1 )
105: SUM = SUM + ABS( A( I, J ) )
106: 30 CONTINUE
107: VALUE = MAX( VALUE, SUM )
108: 40 CONTINUE
109: ELSE IF( LSAME( NORM, 'I' ) ) THEN
110: *
111: * Find normI(A).
112: *
113: DO 50 I = 1, N
114: WORK( I ) = ZERO
115: 50 CONTINUE
116: DO 70 J = 1, N
117: DO 60 I = 1, MIN( N, J+1 )
118: WORK( I ) = WORK( I ) + ABS( A( I, J ) )
119: 60 CONTINUE
120: 70 CONTINUE
121: VALUE = ZERO
122: DO 80 I = 1, N
123: VALUE = MAX( VALUE, WORK( I ) )
124: 80 CONTINUE
125: ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
126: *
127: * Find normF(A).
128: *
129: SCALE = ZERO
130: SUM = ONE
131: DO 90 J = 1, N
132: CALL DLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM )
133: 90 CONTINUE
134: VALUE = SCALE*SQRT( SUM )
135: END IF
136: *
137: DLANHS = VALUE
138: RETURN
139: *
140: * End of DLANHS
141: *
142: END