LAPACK 3.12.0
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 123 of file slantp.f.

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*
sisnan
logical function sisnan(sin)
SISNAN tests input for NaN.
Definition sisnan.f:59
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:124
slassq
subroutine slassq(n, x, incx, scale, sumsq)
SLASSQ updates a sum of squares represented in scaled form.
Definition slassq.f90:124
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: