124 REAL function
clantp( norm, uplo, diag, n, ap, work )
131 CHARACTER diag, norm, uplo
143 parameter( one = 1.0e+0, zero = 0.0e+0 )
148 REAL scale, sum, value
164 ELSE IF(
lsame( norm,
'M' ) )
THEN
169 IF(
lsame( diag,
'U' ) )
THEN
171 IF(
lsame( uplo,
'U' ) )
THEN
173 DO 10 i = k, k + j - 2
175 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
181 DO 30 i = k + 1, k + n - j
183 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
190 IF(
lsame( uplo,
'U' ) )
THEN
192 DO 50 i = k, k + j - 1
194 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
200 DO 70 i = k, k + n - j
202 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
208 ELSE IF( (
lsame( norm,
'O' ) ) .OR. ( norm.EQ.
'1' ) )
THEN
214 udiag =
lsame( diag,
'U' )
215 IF(
lsame( uplo,
'U' ) )
THEN
219 DO 90 i = k, k + j - 2
220 sum = sum + abs( ap( i ) )
224 DO 100 i = k, k + j - 1
225 sum = sum + abs( ap( i ) )
229 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
235 DO 120 i = k + 1, k + n - j
236 sum = sum + abs( ap( i ) )
240 DO 130 i = k, k + n - j
241 sum = sum + abs( ap( i ) )
245 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
248 ELSE IF(
lsame( norm,
'I' ) )
THEN
253 IF(
lsame( uplo,
'U' ) )
THEN
254 IF(
lsame( diag,
'U' ) )
THEN
260 work( i ) = work( i ) + abs( ap( k ) )
271 work( i ) = work( i ) + abs( ap( k ) )
277 IF(
lsame( diag,
'U' ) )
THEN
284 work( i ) = work( i ) + abs( ap( k ) )
294 work( i ) = work( i ) + abs( ap( k ) )
303 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
305 ELSE IF( (
lsame( norm,
'F' ) ) .OR. (
lsame( norm,
'E' ) ) )
THEN
309 IF(
lsame( uplo,
'U' ) )
THEN
310 IF(
lsame( diag,
'U' ) )
THEN
315 CALL classq( j-1, ap( k ), 1, scale, sum )
323 CALL classq( j, ap( k ), 1, scale, sum )
328 IF(
lsame( diag,
'U' ) )
THEN
333 CALL classq( n-j, ap( k ), 1, scale, sum )
341 CALL classq( n-j+1, ap( k ), 1, scale, sum )
346 VALUE = scale*sqrt( sum )
subroutine classq(n, x, incx, scl, sumsq)
CLASSQ updates a sum of squares represented in scaled form.
logical function sisnan(SIN)
SISNAN tests input for NaN.
logical function lsame(CA, CB)
LSAME
real function clantp(NORM, UPLO, DIAG, N, AP, WORK)
CLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...