LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ slantp()

real function slantp ( character norm,
character uplo,
character diag,
integer n,
real, dimension( * ) ap,
real, dimension( * ) work )

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.

Download SLANTP + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!> SLANTP  returns the value of the one norm,  or the Frobenius norm, or
!> the  infinity norm,  or the  element of  largest absolute value  of a
!> triangular matrix A, supplied in packed form.
!>
Returns
SLANTP 
!>
!>    SLANTP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
!>             (
!>             ( norm1(A),         NORM = '1', 'O' or 'o'
!>             (
!>             ( normI(A),         NORM = 'I' or 'i'
!>             (
!>             ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
!>
!> where  norm1  denotes the  one norm of a matrix (maximum column sum),
!> normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
!> normF  denotes the  Frobenius norm of a matrix (square root of sum of
!> squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
!>
Parameters
[in]NORM
!>          NORM is CHARACTER*1
!>          Specifies the value to be returned in SLANTP as described
!>          above.
!>
[in]UPLO
!>          UPLO is CHARACTER*1
!>          Specifies whether the matrix A is upper or lower triangular.
!>          = 'U':  Upper triangular
!>          = 'L':  Lower triangular
!>
[in]DIAG
!>          DIAG is CHARACTER*1
!>          Specifies whether or not the matrix A is unit triangular.
!>          = 'N':  Non-unit triangular
!>          = 'U':  Unit triangular
!>
[in]N
!>          N is INTEGER
!>          The order of the matrix A.  N >= 0.  When N = 0, SLANTP is
!>          set to zero.
!>
[in]AP
!>          AP is REAL array, dimension (N*(N+1)/2)
!>          The upper or lower triangular matrix A, packed columnwise in
!>          a linear array.  The j-th column of A is stored in the array
!>          AP as follows:
!>          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
!>          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
!>          Note that when DIAG = 'U', the elements of the array AP
!>          corresponding to the diagonal elements of the matrix A are
!>          not referenced, but are assumed to be one.
!>
[out]WORK
!>          WORK is REAL array, dimension (MAX(1,LWORK)),
!>          where LWORK >= N when NORM = 'I'; otherwise, WORK is not
!>          referenced.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 121 of file slantp.f.

123*
124* -- LAPACK auxiliary routine --
125* -- LAPACK is a software package provided by Univ. of Tennessee, --
126* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
127*
128* .. Scalar Arguments ..
129 CHARACTER DIAG, NORM, UPLO
130 INTEGER N
131* ..
132* .. Array Arguments ..
133 REAL AP( * ), WORK( * )
134* ..
135*
136* =====================================================================
137*
138* .. Parameters ..
139 REAL ONE, ZERO
140 parameter( one = 1.0e+0, zero = 0.0e+0 )
141* ..
142* .. Local Scalars ..
143 LOGICAL UDIAG
144 INTEGER I, J, K
145 REAL SCALE, SUM, VALUE
146* ..
147* .. External Subroutines ..
148 EXTERNAL slassq
149* ..
150* .. External Functions ..
151 LOGICAL LSAME, SISNAN
152 EXTERNAL lsame, sisnan
153* ..
154* .. Intrinsic Functions ..
155 INTRINSIC abs, sqrt
156* ..
157* .. Executable Statements ..
158*
159 IF( n.EQ.0 ) THEN
160 VALUE = zero
161 ELSE IF( lsame( norm, 'M' ) ) THEN
162*
163* Find max(abs(A(i,j))).
164*
165 k = 1
166 IF( lsame( diag, 'U' ) ) THEN
167 VALUE = one
168 IF( lsame( uplo, 'U' ) ) THEN
169 DO 20 j = 1, n
170 DO 10 i = k, k + j - 2
171 sum = abs( ap( i ) )
172 IF( VALUE .LT. sum .OR.
173 $ 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.
182 $ sisnan( sum ) ) VALUE = sum
183 30 CONTINUE
184 k = k + n - j + 1
185 40 CONTINUE
186 END IF
187 ELSE
188 VALUE = zero
189 IF( lsame( uplo, 'U' ) ) THEN
190 DO 60 j = 1, n
191 DO 50 i = k, k + j - 1
192 sum = abs( ap( i ) )
193 IF( VALUE .LT. sum .OR.
194 $ sisnan( sum ) ) VALUE = sum
195 50 CONTINUE
196 k = k + j
197 60 CONTINUE
198 ELSE
199 DO 80 j = 1, n
200 DO 70 i = k, k + n - j
201 sum = abs( ap( i ) )
202 IF( VALUE .LT. sum .OR.
203 $ sisnan( sum ) ) VALUE = sum
204 70 CONTINUE
205 k = k + n - j + 1
206 80 CONTINUE
207 END IF
208 END IF
209 ELSE IF( ( lsame( norm, 'O' ) ) .OR. ( norm.EQ.'1' ) ) THEN
210*
211* Find norm1(A).
212*
213 VALUE = zero
214 k = 1
215 udiag = lsame( diag, 'U' )
216 IF( lsame( uplo, 'U' ) ) THEN
217 DO 110 j = 1, n
218 IF( udiag ) THEN
219 sum = one
220 DO 90 i = k, k + j - 2
221 sum = sum + abs( ap( i ) )
222 90 CONTINUE
223 ELSE
224 sum = zero
225 DO 100 i = k, k + j - 1
226 sum = sum + abs( ap( i ) )
227 100 CONTINUE
228 END IF
229 k = k + j
230 IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
231 110 CONTINUE
232 ELSE
233 DO 140 j = 1, n
234 IF( udiag ) THEN
235 sum = one
236 DO 120 i = k + 1, k + n - j
237 sum = sum + abs( ap( i ) )
238 120 CONTINUE
239 ELSE
240 sum = zero
241 DO 130 i = k, k + n - j
242 sum = sum + abs( ap( i ) )
243 130 CONTINUE
244 END IF
245 k = k + n - j + 1
246 IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
247 140 CONTINUE
248 END IF
249 ELSE IF( lsame( norm, 'I' ) ) THEN
250*
251* Find normI(A).
252*
253 k = 1
254 IF( lsame( uplo, 'U' ) ) THEN
255 IF( lsame( diag, 'U' ) ) THEN
256 DO 150 i = 1, n
257 work( i ) = one
258 150 CONTINUE
259 DO 170 j = 1, n
260 DO 160 i = 1, j - 1
261 work( i ) = work( i ) + abs( ap( k ) )
262 k = k + 1
263 160 CONTINUE
264 k = k + 1
265 170 CONTINUE
266 ELSE
267 DO 180 i = 1, n
268 work( i ) = zero
269 180 CONTINUE
270 DO 200 j = 1, n
271 DO 190 i = 1, j
272 work( i ) = work( i ) + abs( ap( k ) )
273 k = k + 1
274 190 CONTINUE
275 200 CONTINUE
276 END IF
277 ELSE
278 IF( lsame( diag, 'U' ) ) THEN
279 DO 210 i = 1, n
280 work( i ) = one
281 210 CONTINUE
282 DO 230 j = 1, n
283 k = k + 1
284 DO 220 i = j + 1, n
285 work( i ) = work( i ) + abs( ap( k ) )
286 k = k + 1
287 220 CONTINUE
288 230 CONTINUE
289 ELSE
290 DO 240 i = 1, n
291 work( i ) = zero
292 240 CONTINUE
293 DO 260 j = 1, n
294 DO 250 i = j, n
295 work( i ) = work( i ) + abs( ap( k ) )
296 k = k + 1
297 250 CONTINUE
298 260 CONTINUE
299 END IF
300 END IF
301 VALUE = zero
302 DO 270 i = 1, n
303 sum = work( i )
304 IF( VALUE .LT. sum .OR. sisnan( sum ) ) VALUE = sum
305 270 CONTINUE
306 ELSE IF( ( lsame( norm, 'F' ) ) .OR.
307 $ ( lsame( norm, 'E' ) ) ) THEN
308*
309* Find normF(A).
310*
311 IF( lsame( uplo, 'U' ) ) THEN
312 IF( lsame( diag, 'U' ) ) THEN
313 scale = one
314 sum = real( n )
315 k = 2
316 DO 280 j = 2, n
317 CALL slassq( j-1, ap( k ), 1, scale, sum )
318 k = k + j
319 280 CONTINUE
320 ELSE
321 scale = zero
322 sum = one
323 k = 1
324 DO 290 j = 1, n
325 CALL slassq( j, ap( k ), 1, scale, sum )
326 k = k + j
327 290 CONTINUE
328 END IF
329 ELSE
330 IF( lsame( diag, 'U' ) ) THEN
331 scale = one
332 sum = real( n )
333 k = 2
334 DO 300 j = 1, n - 1
335 CALL slassq( n-j, ap( k ), 1, scale, sum )
336 k = k + n - j + 1
337 300 CONTINUE
338 ELSE
339 scale = zero
340 sum = one
341 k = 1
342 DO 310 j = 1, n
343 CALL slassq( n-j+1, ap( k ), 1, scale, sum )
344 k = k + n - j + 1
345 310 CONTINUE
346 END IF
347 END IF
348 VALUE = scale*sqrt( sum )
349 END IF
350*
351 slantp = VALUE
352 RETURN
353*
354* End of SLANTP
355*
sisnan
logical function sisnan(sin)
SISNAN tests input for NaN.
Definition sisnan.f:57
slantp
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:123
slassq
subroutine slassq(n, x, incx, scale, sumsq)
SLASSQ updates a sum of squares represented in scaled form.
Definition slassq.f90:122
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: