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