|
5826
|
1 DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, |
|
|
2 $ WORK ) |
|
|
3 * |
|
7034
|
4 * -- LAPACK auxiliary routine (version 3.1) -- |
|
|
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. |
|
|
6 * November 2006 |
|
5826
|
7 * |
|
|
8 * .. Scalar Arguments .. |
|
|
9 CHARACTER DIAG, NORM, UPLO |
|
|
10 INTEGER LDA, M, N |
|
|
11 * .. |
|
|
12 * .. Array Arguments .. |
|
|
13 DOUBLE PRECISION WORK( * ) |
|
|
14 COMPLEX*16 A( LDA, * ) |
|
|
15 * .. |
|
|
16 * |
|
|
17 * Purpose |
|
|
18 * ======= |
|
|
19 * |
|
|
20 * ZLANTR 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 * ZLANTR returns the value |
|
|
28 * |
|
|
29 * ZLANTR = ( 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 |
|
7034
|
40 * squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. |
|
5826
|
41 * |
|
|
42 * Arguments |
|
|
43 * ========= |
|
|
44 * |
|
|
45 * NORM (input) CHARACTER*1 |
|
|
46 * Specifies the value to be returned in ZLANTR 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, ZLANTR 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, ZLANTR is set to zero. |
|
|
67 * |
|
|
68 * A (input) COMPLEX*16 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 * |
|
7034
|
82 * WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)), |
|
5826
|
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 Functions .. |
|
|
98 LOGICAL LSAME |
|
|
99 EXTERNAL LSAME |
|
|
100 * .. |
|
|
101 * .. External Subroutines .. |
|
|
102 EXTERNAL ZLASSQ |
|
|
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 ZLASSQ( 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 ZLASSQ( 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 ZLASSQ( 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 ZLASSQ( 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 ZLANTR = VALUE |
|
|
273 RETURN |
|
|
274 * |
|
|
275 * End of ZLANTR |
|
|
276 * |
|
|
277 END |
