1 DOUBLE PRECISION FUNCTION DLANGE( NORM, M, 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, M, N
11 * ..
12 * .. Array Arguments ..
13 DOUBLE PRECISION A( LDA, * ), WORK( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DLANGE 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 * real matrix A.
22 *
23 * Description
24 * ===========
25 *
26 * DLANGE returns the value
27 *
28 * DLANGE = ( 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 DLANGE as described
46 * above.
47 *
48 * M (input) INTEGER
49 * The number of rows of the matrix A. M >= 0. When M = 0,
50 * DLANGE is set to zero.
51 *
52 * N (input) INTEGER
53 * The number of columns of the matrix A. N >= 0. When N = 0,
54 * DLANGE is set to zero.
55 *
56 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
57 * The m by n matrix A.
58 *
59 * LDA (input) INTEGER
60 * The leading dimension of the array A. LDA >= max(M,1).
61 *
62 * WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
63 * where LWORK >= M when NORM = 'I'; otherwise, WORK is not
64 * referenced.
65 *
66 * =====================================================================
67 *
68 * .. Parameters ..
69 DOUBLE PRECISION ONE, ZERO
70 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
71 * ..
72 * .. Local Scalars ..
73 INTEGER I, J
74 DOUBLE PRECISION SCALE, SUM, VALUE
75 * ..
76 * .. External Subroutines ..
77 EXTERNAL DLASSQ
78 * ..
79 * .. External Functions ..
80 LOGICAL LSAME
81 EXTERNAL LSAME
82 * ..
83 * .. Intrinsic Functions ..
84 INTRINSIC ABS, MAX, MIN, SQRT
85 * ..
86 * .. Executable Statements ..
87 *
88 IF( MIN( M, N ).EQ.0 ) THEN
89 VALUE = ZERO
90 ELSE IF( LSAME( NORM, 'M' ) ) THEN
91 *
92 * Find max(abs(A(i,j))).
93 *
94 VALUE = ZERO
95 DO 20 J = 1, N
96 DO 10 I = 1, M
97 VALUE = MAX( VALUE, ABS( A( I, J ) ) )
98 10 CONTINUE
99 20 CONTINUE
100 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
101 *
102 * Find norm1(A).
103 *
104 VALUE = ZERO
105 DO 40 J = 1, N
106 SUM = ZERO
107 DO 30 I = 1, M
108 SUM = SUM + ABS( A( I, J ) )
109 30 CONTINUE
110 VALUE = MAX( VALUE, SUM )
111 40 CONTINUE
112 ELSE IF( LSAME( NORM, 'I' ) ) THEN
113 *
114 * Find normI(A).
115 *
116 DO 50 I = 1, M
117 WORK( I ) = ZERO
118 50 CONTINUE
119 DO 70 J = 1, N
120 DO 60 I = 1, M
121 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
122 60 CONTINUE
123 70 CONTINUE
124 VALUE = ZERO
125 DO 80 I = 1, M
126 VALUE = MAX( VALUE, WORK( I ) )
127 80 CONTINUE
128 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
129 *
130 * Find normF(A).
131 *
132 SCALE = ZERO
133 SUM = ONE
134 DO 90 J = 1, N
135 CALL DLASSQ( M, A( 1, J ), 1, SCALE, SUM )
136 90 CONTINUE
137 VALUE = SCALE*SQRT( SUM )
138 END IF
139 *
140 DLANGE = VALUE
141 RETURN
142 *
143 * End of DLANGE
144 *
145 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, M, N
11 * ..
12 * .. Array Arguments ..
13 DOUBLE PRECISION A( LDA, * ), WORK( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DLANGE 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 * real matrix A.
22 *
23 * Description
24 * ===========
25 *
26 * DLANGE returns the value
27 *
28 * DLANGE = ( 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 DLANGE as described
46 * above.
47 *
48 * M (input) INTEGER
49 * The number of rows of the matrix A. M >= 0. When M = 0,
50 * DLANGE is set to zero.
51 *
52 * N (input) INTEGER
53 * The number of columns of the matrix A. N >= 0. When N = 0,
54 * DLANGE is set to zero.
55 *
56 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
57 * The m by n matrix A.
58 *
59 * LDA (input) INTEGER
60 * The leading dimension of the array A. LDA >= max(M,1).
61 *
62 * WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
63 * where LWORK >= M when NORM = 'I'; otherwise, WORK is not
64 * referenced.
65 *
66 * =====================================================================
67 *
68 * .. Parameters ..
69 DOUBLE PRECISION ONE, ZERO
70 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
71 * ..
72 * .. Local Scalars ..
73 INTEGER I, J
74 DOUBLE PRECISION SCALE, SUM, VALUE
75 * ..
76 * .. External Subroutines ..
77 EXTERNAL DLASSQ
78 * ..
79 * .. External Functions ..
80 LOGICAL LSAME
81 EXTERNAL LSAME
82 * ..
83 * .. Intrinsic Functions ..
84 INTRINSIC ABS, MAX, MIN, SQRT
85 * ..
86 * .. Executable Statements ..
87 *
88 IF( MIN( M, N ).EQ.0 ) THEN
89 VALUE = ZERO
90 ELSE IF( LSAME( NORM, 'M' ) ) THEN
91 *
92 * Find max(abs(A(i,j))).
93 *
94 VALUE = ZERO
95 DO 20 J = 1, N
96 DO 10 I = 1, M
97 VALUE = MAX( VALUE, ABS( A( I, J ) ) )
98 10 CONTINUE
99 20 CONTINUE
100 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
101 *
102 * Find norm1(A).
103 *
104 VALUE = ZERO
105 DO 40 J = 1, N
106 SUM = ZERO
107 DO 30 I = 1, M
108 SUM = SUM + ABS( A( I, J ) )
109 30 CONTINUE
110 VALUE = MAX( VALUE, SUM )
111 40 CONTINUE
112 ELSE IF( LSAME( NORM, 'I' ) ) THEN
113 *
114 * Find normI(A).
115 *
116 DO 50 I = 1, M
117 WORK( I ) = ZERO
118 50 CONTINUE
119 DO 70 J = 1, N
120 DO 60 I = 1, M
121 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
122 60 CONTINUE
123 70 CONTINUE
124 VALUE = ZERO
125 DO 80 I = 1, M
126 VALUE = MAX( VALUE, WORK( I ) )
127 80 CONTINUE
128 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
129 *
130 * Find normF(A).
131 *
132 SCALE = ZERO
133 SUM = ONE
134 DO 90 J = 1, N
135 CALL DLASSQ( M, A( 1, J ), 1, SCALE, SUM )
136 90 CONTINUE
137 VALUE = SCALE*SQRT( SUM )
138 END IF
139 *
140 DLANGE = VALUE
141 RETURN
142 *
143 * End of DLANGE
144 *
145 END