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