1 DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
2 $ WORK )
3 *
4 * -- LAPACK auxiliary routine (version 3.2) --
5 * -- LAPACK is a software package provided by Univ. of Tennessee, --
6 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 CHARACTER DIAG, NORM, UPLO
11 INTEGER LDA, M, N
12 * ..
13 * .. Array Arguments ..
14 DOUBLE PRECISION A( LDA, * ), WORK( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * DLANTR returns the value of the one norm, or the Frobenius norm, or
21 * the infinity norm, or the element of largest absolute value of a
22 * trapezoidal or triangular matrix A.
23 *
24 * Description
25 * ===========
26 *
27 * DLANTR returns the value
28 *
29 * DLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
30 * (
31 * ( norm1(A), NORM = '1', 'O' or 'o'
32 * (
33 * ( normI(A), NORM = 'I' or 'i'
34 * (
35 * ( normF(A), NORM = 'F', 'f', 'E' or 'e'
36 *
37 * where norm1 denotes the one norm of a matrix (maximum column sum),
38 * normI denotes the infinity norm of a matrix (maximum row sum) and
39 * normF denotes the Frobenius norm of a matrix (square root of sum of
40 * squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
41 *
42 * Arguments
43 * =========
44 *
45 * NORM (input) CHARACTER*1
46 * Specifies the value to be returned in DLANTR as described
47 * above.
48 *
49 * UPLO (input) CHARACTER*1
50 * Specifies whether the matrix A is upper or lower trapezoidal.
51 * = 'U': Upper trapezoidal
52 * = 'L': Lower trapezoidal
53 * Note that A is triangular instead of trapezoidal if M = N.
54 *
55 * DIAG (input) CHARACTER*1
56 * Specifies whether or not the matrix A has unit diagonal.
57 * = 'N': Non-unit diagonal
58 * = 'U': Unit diagonal
59 *
60 * M (input) INTEGER
61 * The number of rows of the matrix A. M >= 0, and if
62 * UPLO = 'U', M <= N. When M = 0, DLANTR is set to zero.
63 *
64 * N (input) INTEGER
65 * The number of columns of the matrix A. N >= 0, and if
66 * UPLO = 'L', N <= M. When N = 0, DLANTR is set to zero.
67 *
68 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
69 * The trapezoidal matrix A (A is triangular if M = N).
70 * If UPLO = 'U', the leading m by n upper trapezoidal part of
71 * the array A contains the upper trapezoidal matrix, and the
72 * strictly lower triangular part of A is not referenced.
73 * If UPLO = 'L', the leading m by n lower trapezoidal part of
74 * the array A contains the lower trapezoidal matrix, and the
75 * strictly upper triangular part of A is not referenced. Note
76 * that when DIAG = 'U', the diagonal elements of A are not
77 * referenced and are assumed to be one.
78 *
79 * LDA (input) INTEGER
80 * The leading dimension of the array A. LDA >= max(M,1).
81 *
82 * WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
83 * where LWORK >= M when NORM = 'I'; otherwise, WORK is not
84 * referenced.
85 *
86 * =====================================================================
87 *
88 * .. Parameters ..
89 DOUBLE PRECISION ONE, ZERO
90 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
91 * ..
92 * .. Local Scalars ..
93 LOGICAL UDIAG
94 INTEGER I, J
95 DOUBLE PRECISION SCALE, SUM, VALUE
96 * ..
97 * .. External Subroutines ..
98 EXTERNAL DLASSQ
99 * ..
100 * .. External Functions ..
101 LOGICAL LSAME
102 EXTERNAL LSAME
103 * ..
104 * .. Intrinsic Functions ..
105 INTRINSIC ABS, MAX, MIN, SQRT
106 * ..
107 * .. Executable Statements ..
108 *
109 IF( MIN( M, N ).EQ.0 ) THEN
110 VALUE = ZERO
111 ELSE IF( LSAME( NORM, 'M' ) ) THEN
112 *
113 * Find max(abs(A(i,j))).
114 *
115 IF( LSAME( DIAG, 'U' ) ) THEN
116 VALUE = ONE
117 IF( LSAME( UPLO, 'U' ) ) THEN
118 DO 20 J = 1, N
119 DO 10 I = 1, MIN( M, J-1 )
120 VALUE = MAX( VALUE, ABS( A( I, J ) ) )
121 10 CONTINUE
122 20 CONTINUE
123 ELSE
124 DO 40 J = 1, N
125 DO 30 I = J + 1, M
126 VALUE = MAX( VALUE, ABS( A( I, J ) ) )
127 30 CONTINUE
128 40 CONTINUE
129 END IF
130 ELSE
131 VALUE = ZERO
132 IF( LSAME( UPLO, 'U' ) ) THEN
133 DO 60 J = 1, N
134 DO 50 I = 1, MIN( M, J )
135 VALUE = MAX( VALUE, ABS( A( I, J ) ) )
136 50 CONTINUE
137 60 CONTINUE
138 ELSE
139 DO 80 J = 1, N
140 DO 70 I = J, M
141 VALUE = MAX( VALUE, ABS( A( I, J ) ) )
142 70 CONTINUE
143 80 CONTINUE
144 END IF
145 END IF
146 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
147 *
148 * Find norm1(A).
149 *
150 VALUE = ZERO
151 UDIAG = LSAME( DIAG, 'U' )
152 IF( LSAME( UPLO, 'U' ) ) THEN
153 DO 110 J = 1, N
154 IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN
155 SUM = ONE
156 DO 90 I = 1, J - 1
157 SUM = SUM + ABS( A( I, J ) )
158 90 CONTINUE
159 ELSE
160 SUM = ZERO
161 DO 100 I = 1, MIN( M, J )
162 SUM = SUM + ABS( A( I, J ) )
163 100 CONTINUE
164 END IF
165 VALUE = MAX( VALUE, SUM )
166 110 CONTINUE
167 ELSE
168 DO 140 J = 1, N
169 IF( UDIAG ) THEN
170 SUM = ONE
171 DO 120 I = J + 1, M
172 SUM = SUM + ABS( A( I, J ) )
173 120 CONTINUE
174 ELSE
175 SUM = ZERO
176 DO 130 I = J, M
177 SUM = SUM + ABS( A( I, J ) )
178 130 CONTINUE
179 END IF
180 VALUE = MAX( VALUE, SUM )
181 140 CONTINUE
182 END IF
183 ELSE IF( LSAME( NORM, 'I' ) ) THEN
184 *
185 * Find normI(A).
186 *
187 IF( LSAME( UPLO, 'U' ) ) THEN
188 IF( LSAME( DIAG, 'U' ) ) THEN
189 DO 150 I = 1, M
190 WORK( I ) = ONE
191 150 CONTINUE
192 DO 170 J = 1, N
193 DO 160 I = 1, MIN( M, J-1 )
194 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
195 160 CONTINUE
196 170 CONTINUE
197 ELSE
198 DO 180 I = 1, M
199 WORK( I ) = ZERO
200 180 CONTINUE
201 DO 200 J = 1, N
202 DO 190 I = 1, MIN( M, J )
203 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
204 190 CONTINUE
205 200 CONTINUE
206 END IF
207 ELSE
208 IF( LSAME( DIAG, 'U' ) ) THEN
209 DO 210 I = 1, N
210 WORK( I ) = ONE
211 210 CONTINUE
212 DO 220 I = N + 1, M
213 WORK( I ) = ZERO
214 220 CONTINUE
215 DO 240 J = 1, N
216 DO 230 I = J + 1, M
217 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
218 230 CONTINUE
219 240 CONTINUE
220 ELSE
221 DO 250 I = 1, M
222 WORK( I ) = ZERO
223 250 CONTINUE
224 DO 270 J = 1, N
225 DO 260 I = J, M
226 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
227 260 CONTINUE
228 270 CONTINUE
229 END IF
230 END IF
231 VALUE = ZERO
232 DO 280 I = 1, M
233 VALUE = MAX( VALUE, WORK( I ) )
234 280 CONTINUE
235 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
236 *
237 * Find normF(A).
238 *
239 IF( LSAME( UPLO, 'U' ) ) THEN
240 IF( LSAME( DIAG, 'U' ) ) THEN
241 SCALE = ONE
242 SUM = MIN( M, N )
243 DO 290 J = 2, N
244 CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
245 290 CONTINUE
246 ELSE
247 SCALE = ZERO
248 SUM = ONE
249 DO 300 J = 1, N
250 CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
251 300 CONTINUE
252 END IF
253 ELSE
254 IF( LSAME( DIAG, 'U' ) ) THEN
255 SCALE = ONE
256 SUM = MIN( M, N )
257 DO 310 J = 1, N
258 CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
259 $ SUM )
260 310 CONTINUE
261 ELSE
262 SCALE = ZERO
263 SUM = ONE
264 DO 320 J = 1, N
265 CALL DLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
266 320 CONTINUE
267 END IF
268 END IF
269 VALUE = SCALE*SQRT( SUM )
270 END IF
271 *
272 DLANTR = VALUE
273 RETURN
274 *
275 * End of DLANTR
276 *
277 END
2 $ WORK )
3 *
4 * -- LAPACK auxiliary routine (version 3.2) --
5 * -- LAPACK is a software package provided by Univ. of Tennessee, --
6 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 CHARACTER DIAG, NORM, UPLO
11 INTEGER LDA, M, N
12 * ..
13 * .. Array Arguments ..
14 DOUBLE PRECISION A( LDA, * ), WORK( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * DLANTR returns the value of the one norm, or the Frobenius norm, or
21 * the infinity norm, or the element of largest absolute value of a
22 * trapezoidal or triangular matrix A.
23 *
24 * Description
25 * ===========
26 *
27 * DLANTR returns the value
28 *
29 * DLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
30 * (
31 * ( norm1(A), NORM = '1', 'O' or 'o'
32 * (
33 * ( normI(A), NORM = 'I' or 'i'
34 * (
35 * ( normF(A), NORM = 'F', 'f', 'E' or 'e'
36 *
37 * where norm1 denotes the one norm of a matrix (maximum column sum),
38 * normI denotes the infinity norm of a matrix (maximum row sum) and
39 * normF denotes the Frobenius norm of a matrix (square root of sum of
40 * squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
41 *
42 * Arguments
43 * =========
44 *
45 * NORM (input) CHARACTER*1
46 * Specifies the value to be returned in DLANTR as described
47 * above.
48 *
49 * UPLO (input) CHARACTER*1
50 * Specifies whether the matrix A is upper or lower trapezoidal.
51 * = 'U': Upper trapezoidal
52 * = 'L': Lower trapezoidal
53 * Note that A is triangular instead of trapezoidal if M = N.
54 *
55 * DIAG (input) CHARACTER*1
56 * Specifies whether or not the matrix A has unit diagonal.
57 * = 'N': Non-unit diagonal
58 * = 'U': Unit diagonal
59 *
60 * M (input) INTEGER
61 * The number of rows of the matrix A. M >= 0, and if
62 * UPLO = 'U', M <= N. When M = 0, DLANTR is set to zero.
63 *
64 * N (input) INTEGER
65 * The number of columns of the matrix A. N >= 0, and if
66 * UPLO = 'L', N <= M. When N = 0, DLANTR is set to zero.
67 *
68 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
69 * The trapezoidal matrix A (A is triangular if M = N).
70 * If UPLO = 'U', the leading m by n upper trapezoidal part of
71 * the array A contains the upper trapezoidal matrix, and the
72 * strictly lower triangular part of A is not referenced.
73 * If UPLO = 'L', the leading m by n lower trapezoidal part of
74 * the array A contains the lower trapezoidal matrix, and the
75 * strictly upper triangular part of A is not referenced. Note
76 * that when DIAG = 'U', the diagonal elements of A are not
77 * referenced and are assumed to be one.
78 *
79 * LDA (input) INTEGER
80 * The leading dimension of the array A. LDA >= max(M,1).
81 *
82 * WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
83 * where LWORK >= M when NORM = 'I'; otherwise, WORK is not
84 * referenced.
85 *
86 * =====================================================================
87 *
88 * .. Parameters ..
89 DOUBLE PRECISION ONE, ZERO
90 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
91 * ..
92 * .. Local Scalars ..
93 LOGICAL UDIAG
94 INTEGER I, J
95 DOUBLE PRECISION SCALE, SUM, VALUE
96 * ..
97 * .. External Subroutines ..
98 EXTERNAL DLASSQ
99 * ..
100 * .. External Functions ..
101 LOGICAL LSAME
102 EXTERNAL LSAME
103 * ..
104 * .. Intrinsic Functions ..
105 INTRINSIC ABS, MAX, MIN, SQRT
106 * ..
107 * .. Executable Statements ..
108 *
109 IF( MIN( M, N ).EQ.0 ) THEN
110 VALUE = ZERO
111 ELSE IF( LSAME( NORM, 'M' ) ) THEN
112 *
113 * Find max(abs(A(i,j))).
114 *
115 IF( LSAME( DIAG, 'U' ) ) THEN
116 VALUE = ONE
117 IF( LSAME( UPLO, 'U' ) ) THEN
118 DO 20 J = 1, N
119 DO 10 I = 1, MIN( M, J-1 )
120 VALUE = MAX( VALUE, ABS( A( I, J ) ) )
121 10 CONTINUE
122 20 CONTINUE
123 ELSE
124 DO 40 J = 1, N
125 DO 30 I = J + 1, M
126 VALUE = MAX( VALUE, ABS( A( I, J ) ) )
127 30 CONTINUE
128 40 CONTINUE
129 END IF
130 ELSE
131 VALUE = ZERO
132 IF( LSAME( UPLO, 'U' ) ) THEN
133 DO 60 J = 1, N
134 DO 50 I = 1, MIN( M, J )
135 VALUE = MAX( VALUE, ABS( A( I, J ) ) )
136 50 CONTINUE
137 60 CONTINUE
138 ELSE
139 DO 80 J = 1, N
140 DO 70 I = J, M
141 VALUE = MAX( VALUE, ABS( A( I, J ) ) )
142 70 CONTINUE
143 80 CONTINUE
144 END IF
145 END IF
146 ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
147 *
148 * Find norm1(A).
149 *
150 VALUE = ZERO
151 UDIAG = LSAME( DIAG, 'U' )
152 IF( LSAME( UPLO, 'U' ) ) THEN
153 DO 110 J = 1, N
154 IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN
155 SUM = ONE
156 DO 90 I = 1, J - 1
157 SUM = SUM + ABS( A( I, J ) )
158 90 CONTINUE
159 ELSE
160 SUM = ZERO
161 DO 100 I = 1, MIN( M, J )
162 SUM = SUM + ABS( A( I, J ) )
163 100 CONTINUE
164 END IF
165 VALUE = MAX( VALUE, SUM )
166 110 CONTINUE
167 ELSE
168 DO 140 J = 1, N
169 IF( UDIAG ) THEN
170 SUM = ONE
171 DO 120 I = J + 1, M
172 SUM = SUM + ABS( A( I, J ) )
173 120 CONTINUE
174 ELSE
175 SUM = ZERO
176 DO 130 I = J, M
177 SUM = SUM + ABS( A( I, J ) )
178 130 CONTINUE
179 END IF
180 VALUE = MAX( VALUE, SUM )
181 140 CONTINUE
182 END IF
183 ELSE IF( LSAME( NORM, 'I' ) ) THEN
184 *
185 * Find normI(A).
186 *
187 IF( LSAME( UPLO, 'U' ) ) THEN
188 IF( LSAME( DIAG, 'U' ) ) THEN
189 DO 150 I = 1, M
190 WORK( I ) = ONE
191 150 CONTINUE
192 DO 170 J = 1, N
193 DO 160 I = 1, MIN( M, J-1 )
194 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
195 160 CONTINUE
196 170 CONTINUE
197 ELSE
198 DO 180 I = 1, M
199 WORK( I ) = ZERO
200 180 CONTINUE
201 DO 200 J = 1, N
202 DO 190 I = 1, MIN( M, J )
203 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
204 190 CONTINUE
205 200 CONTINUE
206 END IF
207 ELSE
208 IF( LSAME( DIAG, 'U' ) ) THEN
209 DO 210 I = 1, N
210 WORK( I ) = ONE
211 210 CONTINUE
212 DO 220 I = N + 1, M
213 WORK( I ) = ZERO
214 220 CONTINUE
215 DO 240 J = 1, N
216 DO 230 I = J + 1, M
217 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
218 230 CONTINUE
219 240 CONTINUE
220 ELSE
221 DO 250 I = 1, M
222 WORK( I ) = ZERO
223 250 CONTINUE
224 DO 270 J = 1, N
225 DO 260 I = J, M
226 WORK( I ) = WORK( I ) + ABS( A( I, J ) )
227 260 CONTINUE
228 270 CONTINUE
229 END IF
230 END IF
231 VALUE = ZERO
232 DO 280 I = 1, M
233 VALUE = MAX( VALUE, WORK( I ) )
234 280 CONTINUE
235 ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
236 *
237 * Find normF(A).
238 *
239 IF( LSAME( UPLO, 'U' ) ) THEN
240 IF( LSAME( DIAG, 'U' ) ) THEN
241 SCALE = ONE
242 SUM = MIN( M, N )
243 DO 290 J = 2, N
244 CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
245 290 CONTINUE
246 ELSE
247 SCALE = ZERO
248 SUM = ONE
249 DO 300 J = 1, N
250 CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
251 300 CONTINUE
252 END IF
253 ELSE
254 IF( LSAME( DIAG, 'U' ) ) THEN
255 SCALE = ONE
256 SUM = MIN( M, N )
257 DO 310 J = 1, N
258 CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
259 $ SUM )
260 310 CONTINUE
261 ELSE
262 SCALE = ZERO
263 SUM = ONE
264 DO 320 J = 1, N
265 CALL DLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
266 320 CONTINUE
267 END IF
268 END IF
269 VALUE = SCALE*SQRT( SUM )
270 END IF
271 *
272 DLANTR = VALUE
273 RETURN
274 *
275 * End of DLANTR
276 *
277 END