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