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
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