130 REAL function
clanhb( norm, uplo, n, k, ab, ldab,
143 COMPLEX ab( ldab, * )
150 parameter( one = 1.0e+0, zero = 0.0e+0 )
154 REAL absa, scale, sum, value
164 INTRINSIC abs, max, min, real, sqrt
170 ELSE IF(
lsame( norm,
'M' ) )
THEN
175 IF(
lsame( uplo,
'U' ) )
THEN
177 DO 10 i = max( k+2-j, 1 ), k
178 sum = abs( ab( i, j ) )
179 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
181 sum = abs( real( ab( k+1, j ) ) )
182 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
186 sum = abs( real( ab( 1, j ) ) )
187 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
188 DO 30 i = 2, min( n+1-j, k+1 )
189 sum = abs( ab( i, j ) )
190 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
194 ELSE IF( (
lsame( norm,
'I' ) ) .OR. (
lsame( norm,
'O' ) ) .OR.
195 $ ( norm.EQ.
'1' ) )
THEN
200 IF(
lsame( uplo,
'U' ) )
THEN
204 DO 50 i = max( 1, j-k ), j - 1
205 absa = abs( ab( l+i, j ) )
207 work( i ) = work( i ) + absa
209 work( j ) = sum + abs( real( ab( k+1, j ) ) )
213 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
220 sum = work( j ) + abs( real( ab( 1, j ) ) )
222 DO 90 i = j + 1, min( n, j+k )
223 absa = abs( ab( l+i, j ) )
225 work( i ) = work( i ) + absa
227 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
230 ELSE IF( (
lsame( norm,
'F' ) ) .OR. (
lsame( norm,
'E' ) ) )
THEN
237 IF(
lsame( uplo,
'U' ) )
THEN
239 CALL classq( min( j-1, k ), ab( max( k+2-j, 1 ), j ),
245 CALL classq( min( n-j, k ), ab( 2, j ), 1, scale,
255 IF( real( ab( l, j ) ).NE.zero )
THEN
256 absa = abs( real( ab( l, j ) ) )
257 IF( scale.LT.absa )
THEN
258 sum = one + sum*( scale / absa )**2
261 sum = sum + ( absa / scale )**2
265 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 clanhb(NORM, UPLO, N, K, AB, LDAB, WORK)
CLANHB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...