LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
slantp.f
Go to the documentation of this file.
1*> \brief \b SLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SLANTP + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slantp.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slantp.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slantp.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* REAL FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, WORK )
22*
23* .. Scalar Arguments ..
24* CHARACTER DIAG, NORM, UPLO
25* INTEGER N
26* ..
27* .. Array Arguments ..
28* REAL AP( * ), WORK( * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> SLANTP returns the value of the one norm, or the Frobenius norm, or
38*> the infinity norm, or the element of largest absolute value of a
39*> triangular matrix A, supplied in packed form.
40*> \endverbatim
41*>
42*> \return SLANTP
43*> \verbatim
44*>
45*> SLANTP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
46*> (
47*> ( norm1(A), NORM = '1', 'O' or 'o'
48*> (
49*> ( normI(A), NORM = 'I' or 'i'
50*> (
51*> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
52*>
53*> where norm1 denotes the one norm of a matrix (maximum column sum),
54*> normI denotes the infinity norm of a matrix (maximum row sum) and
55*> normF denotes the Frobenius norm of a matrix (square root of sum of
56*> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
57*> \endverbatim
58*
59* Arguments:
60* ==========
61*
62*> \param[in] NORM
63*> \verbatim
64*> NORM is CHARACTER*1
65*> Specifies the value to be returned in SLANTP as described
66*> above.
67*> \endverbatim
68*>
69*> \param[in] UPLO
70*> \verbatim
71*> UPLO is CHARACTER*1
72*> Specifies whether the matrix A is upper or lower triangular.
73*> = 'U': Upper triangular
74*> = 'L': Lower triangular
75*> \endverbatim
76*>
77*> \param[in] DIAG
78*> \verbatim
79*> DIAG is CHARACTER*1
80*> Specifies whether or not the matrix A is unit triangular.
81*> = 'N': Non-unit triangular
82*> = 'U': Unit triangular
83*> \endverbatim
84*>
85*> \param[in] N
86*> \verbatim
87*> N is INTEGER
88*> The order of the matrix A. N >= 0. When N = 0, SLANTP is
89*> set to zero.
90*> \endverbatim
91*>
92*> \param[in] AP
93*> \verbatim
94*> AP is REAL array, dimension (N*(N+1)/2)
95*> The upper or lower triangular matrix A, packed columnwise in
96*> a linear array. The j-th column of A is stored in the array
97*> AP as follows:
98*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
99*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
100*> Note that when DIAG = 'U', the elements of the array AP
101*> corresponding to the diagonal elements of the matrix A are
102*> not referenced, but are assumed to be one.
103*> \endverbatim
104*>
105*> \param[out] WORK
106*> \verbatim
107*> WORK is REAL array, dimension (MAX(1,LWORK)),
108*> where LWORK >= N when NORM = 'I'; otherwise, WORK is not
109*> referenced.
110*> \endverbatim
111*
112* Authors:
113* ========
114*
115*> \author Univ. of Tennessee
116*> \author Univ. of California Berkeley
117*> \author Univ. of Colorado Denver
118*> \author NAG Ltd.
119*
120*> \ingroup lantp
121*
122* =====================================================================
123 REAL function slantp( norm, uplo, diag, n, ap, work )
124*
125* -- LAPACK auxiliary routine --
126* -- LAPACK is a software package provided by Univ. of Tennessee, --
127* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
128*
129* .. Scalar Arguments ..
130 CHARACTER diag, norm, uplo
131 INTEGER n
132* ..
133* .. Array Arguments ..
134 REAL ap( * ), work( * )
135* ..
136*
137* =====================================================================
138*
139* .. Parameters ..
140 REAL one, zero
141 parameter( one = 1.0e+0, zero = 0.0e+0 )
142* ..
143* .. Local Scalars ..
144 LOGICAL udiag
145 INTEGER i, j, k
146 REAL scale, sum, value
147* ..
148* .. External Subroutines ..
149 EXTERNAL slassq
150* ..
151* .. External Functions ..
152 LOGICAL lsame, sisnan
153 EXTERNAL lsame, sisnan
154* ..
155* .. Intrinsic Functions ..
156 INTRINSIC abs, sqrt
157* ..
158* .. Executable Statements ..
159*
160 IF( n.EQ.0 ) THEN
161 VALUE = zero
162 ELSE IF( lsame( norm, 'M' ) ) THEN
163*
164* Find max(abs(A(i,j))).
165*
166 k = 1
167 IF( lsame( diag, 'U' ) ) THEN
168 VALUE = one
169 IF( lsame( uplo, 'U' ) ) THEN
170 DO 20 j = 1, n
171 DO 10 i = k, k + j - 2
172 sum = abs( ap( i ) )
173 IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
174 10 CONTINUE
175 k = k + j
176 20 CONTINUE
177 ELSE
178 DO 40 j = 1, n
179 DO 30 i = k + 1, k + n - j
180 sum = abs( ap( i ) )
181 IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
182 30 CONTINUE
183 k = k + n - j + 1
184 40 CONTINUE
185 END IF
186 ELSE
187 VALUE = zero
188 IF( lsame( uplo, 'U' ) ) THEN
189 DO 60 j = 1, n
190 DO 50 i = k, k + j - 1
191 sum = abs( ap( i ) )
192 IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
193 50 CONTINUE
194 k = k + j
195 60 CONTINUE
196 ELSE
197 DO 80 j = 1, n
198 DO 70 i = k, k + n - j
199 sum = abs( ap( i ) )
200 IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
201 70 CONTINUE
202 k = k + n - j + 1
203 80 CONTINUE
204 END IF
205 END IF
206 ELSE IF( ( lsame( norm, 'O' ) ) .OR. ( norm.EQ.'1' ) ) THEN
207*
208* Find norm1(A).
209*
210 VALUE = zero
211 k = 1
212 udiag = lsame( diag, 'U' )
213 IF( lsame( uplo, 'U' ) ) THEN
214 DO 110 j = 1, n
215 IF( udiag ) THEN
216 sum = one
217 DO 90 i = k, k + j - 2
218 sum = sum + abs( ap( i ) )
219 90 CONTINUE
220 ELSE
221 sum = zero
222 DO 100 i = k, k + j - 1
223 sum = sum + abs( ap( i ) )
224 100 CONTINUE
225 END IF
226 k = k + j
227 IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
228 110 CONTINUE
229 ELSE
230 DO 140 j = 1, n
231 IF( udiag ) THEN
232 sum = one
233 DO 120 i = k + 1, k + n - j
234 sum = sum + abs( ap( i ) )
235 120 CONTINUE
236 ELSE
237 sum = zero
238 DO 130 i = k, k + n - j
239 sum = sum + abs( ap( i ) )
240 130 CONTINUE
241 END IF
242 k = k + n - j + 1
243 IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
244 140 CONTINUE
245 END IF
246 ELSE IF( lsame( norm, 'I' ) ) THEN
247*
248* Find normI(A).
249*
250 k = 1
251 IF( lsame( uplo, 'U' ) ) THEN
252 IF( lsame( diag, 'U' ) ) THEN
253 DO 150 i = 1, n
254 work( i ) = one
255 150 CONTINUE
256 DO 170 j = 1, n
257 DO 160 i = 1, j - 1
258 work( i ) = work( i ) + abs( ap( k ) )
259 k = k + 1
260 160 CONTINUE
261 k = k + 1
262 170 CONTINUE
263 ELSE
264 DO 180 i = 1, n
265 work( i ) = zero
266 180 CONTINUE
267 DO 200 j = 1, n
268 DO 190 i = 1, j
269 work( i ) = work( i ) + abs( ap( k ) )
270 k = k + 1
271 190 CONTINUE
272 200 CONTINUE
273 END IF
274 ELSE
275 IF( lsame( diag, 'U' ) ) THEN
276 DO 210 i = 1, n
277 work( i ) = one
278 210 CONTINUE
279 DO 230 j = 1, n
280 k = k + 1
281 DO 220 i = j + 1, n
282 work( i ) = work( i ) + abs( ap( k ) )
283 k = k + 1
284 220 CONTINUE
285 230 CONTINUE
286 ELSE
287 DO 240 i = 1, n
288 work( i ) = zero
289 240 CONTINUE
290 DO 260 j = 1, n
291 DO 250 i = j, n
292 work( i ) = work( i ) + abs( ap( k ) )
293 k = k + 1
294 250 CONTINUE
295 260 CONTINUE
296 END IF
297 END IF
298 VALUE = zero
299 DO 270 i = 1, n
300 sum = work( i )
301 IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
302 270 CONTINUE
303 ELSE IF( ( lsame( norm, 'F' ) ) .OR. ( lsame( norm, 'E' ) ) ) THEN
304*
305* Find normF(A).
306*
307 IF( lsame( uplo, 'U' ) ) THEN
308 IF( lsame( diag, 'U' ) ) THEN
309 scale = one
310 sum = n
311 k = 2
312 DO 280 j = 2, n
313 CALL slassq( j-1, ap( k ), 1, scale, sum )
314 k = k + j
315 280 CONTINUE
316 ELSE
317 scale = zero
318 sum = one
319 k = 1
320 DO 290 j = 1, n
321 CALL slassq( j, ap( k ), 1, scale, sum )
322 k = k + j
323 290 CONTINUE
324 END IF
325 ELSE
326 IF( lsame( diag, 'U' ) ) THEN
327 scale = one
328 sum = n
329 k = 2
330 DO 300 j = 1, n - 1
331 CALL slassq( n-j, ap( k ), 1, scale, sum )
332 k = k + n - j + 1
333 300 CONTINUE
334 ELSE
335 scale = zero
336 sum = one
337 k = 1
338 DO 310 j = 1, n
339 CALL slassq( n-j+1, ap( k ), 1, scale, sum )
340 k = k + n - j + 1
341 310 CONTINUE
342 END IF
343 END IF
344 VALUE = scale*sqrt( sum )
345 END IF
346*
347 slantp = VALUE
348 RETURN
349*
350* End of SLANTP
351*
352 END
logical function sisnan(sin)
SISNAN tests input for NaN.
Definition sisnan.f:59
real function slantp(norm, uplo, diag, n, ap, work)
SLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
Definition slantp.f:124
subroutine slassq(n, x, incx, scale, sumsq)
SLASSQ updates a sum of squares represented in scaled form.
Definition slassq.f90:124
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48