113 REAL function
slansp( norm, uplo, n, ap, work )
124 REAL ap( * ), work( * )
131 parameter( one = 1.0e+0, zero = 0.0e+0 )
135 REAL absa, scale, sum, value
151 ELSE IF(
lsame( norm,
'M' ) )
THEN
156 IF(
lsame( uplo,
'U' ) )
THEN
159 DO 10 i = k, k + j - 1
161 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
168 DO 30 i = k, k + n - j
170 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
175 ELSE IF( (
lsame( norm,
'I' ) ) .OR. (
lsame( norm,
'O' ) ) .OR.
176 $ ( norm.EQ.
'1' ) )
THEN
182 IF(
lsame( uplo,
'U' ) )
THEN
186 absa = abs( ap( k ) )
188 work( i ) = work( i ) + absa
191 work( j ) = sum + abs( ap( k ) )
196 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
203 sum = work( j ) + abs( ap( k ) )
206 absa = abs( ap( k ) )
208 work( i ) = work( i ) + absa
211 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
214 ELSE IF( (
lsame( norm,
'F' ) ) .OR. (
lsame( norm,
'E' ) ) )
THEN
221 IF(
lsame( uplo,
'U' ) )
THEN
223 CALL slassq( j-1, ap( k ), 1, scale, sum )
228 CALL slassq( n-j, ap( k ), 1, scale, sum )
235 IF( ap( k ).NE.zero )
THEN
236 absa = abs( ap( k ) )
237 IF( scale.LT.absa )
THEN
238 sum = one + sum*( scale / absa )**2
241 sum = sum + ( absa / scale )**2
244 IF(
lsame( uplo,
'U' ) )
THEN
250 VALUE = scale*sqrt( sum )
subroutine slassq(n, x, incx, scl, sumsq)
SLASSQ 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 slansp(NORM, UPLO, N, AP, WORK)
SLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...