139 REAL function
clantb( norm, uplo, diag, n, k, ab,
147 CHARACTER diag, norm, uplo
152 COMPLEX ab( ldab, * )
159 parameter( one = 1.0e+0, zero = 0.0e+0 )
164 REAL scale, sum, value
174 INTRINSIC abs, max, min, sqrt
180 ELSE IF(
lsame( norm,
'M' ) )
THEN
184 IF(
lsame( diag,
'U' ) )
THEN
186 IF(
lsame( uplo,
'U' ) )
THEN
188 DO 10 i = max( k+2-j, 1 ), k
189 sum = abs( ab( i, j ) )
190 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
195 DO 30 i = 2, min( n+1-j, k+1 )
196 sum = abs( ab( i, j ) )
197 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
203 IF(
lsame( uplo,
'U' ) )
THEN
205 DO 50 i = max( k+2-j, 1 ), k + 1
206 sum = abs( ab( i, j ) )
207 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
212 DO 70 i = 1, min( n+1-j, k+1 )
213 sum = abs( ab( i, j ) )
214 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
219 ELSE IF( (
lsame( norm,
'O' ) ) .OR. ( norm.EQ.
'1' ) )
THEN
224 udiag =
lsame( diag,
'U' )
225 IF(
lsame( uplo,
'U' ) )
THEN
229 DO 90 i = max( k+2-j, 1 ), k
230 sum = sum + abs( ab( i, j ) )
234 DO 100 i = max( k+2-j, 1 ), k + 1
235 sum = sum + abs( ab( i, j ) )
238 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
244 DO 120 i = 2, min( n+1-j, k+1 )
245 sum = sum + abs( ab( i, j ) )
249 DO 130 i = 1, min( n+1-j, k+1 )
250 sum = sum + abs( ab( i, j ) )
253 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
256 ELSE IF(
lsame( norm,
'I' ) )
THEN
261 IF(
lsame( uplo,
'U' ) )
THEN
262 IF(
lsame( diag,
'U' ) )
THEN
268 DO 160 i = max( 1, j-k ), j - 1
269 work( i ) = work( i ) + abs( ab( l+i, j ) )
278 DO 190 i = max( 1, j-k ), j
279 work( i ) = work( i ) + abs( ab( l+i, j ) )
284 IF(
lsame( diag,
'U' ) )
THEN
290 DO 220 i = j + 1, min( n, j+k )
291 work( i ) = work( i ) + abs( ab( l+i, j ) )
300 DO 250 i = j, min( n, j+k )
301 work( i ) = work( i ) + abs( ab( l+i, j ) )
308 IF(
VALUE .LT. sum .OR.
sisnan( sum ) )
VALUE = sum
310 ELSE IF( (
lsame( norm,
'F' ) ) .OR. (
lsame( norm,
'E' ) ) )
THEN
314 IF(
lsame( uplo,
'U' ) )
THEN
315 IF(
lsame( diag,
'U' ) )
THEN
320 CALL classq( min( j-1, k ),
321 $ ab( max( k+2-j, 1 ), j ), 1, scale,
329 CALL classq( min( j, k+1 ), ab( max( k+2-j, 1 ), j ),
334 IF(
lsame( diag,
'U' ) )
THEN
339 CALL classq( min( n-j, k ), ab( 2, j ), 1, scale,
347 CALL classq( min( n-j+1, k+1 ), ab( 1, j ), 1, scale,
352 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 clantb(NORM, UPLO, DIAG, N, K, AB, LDAB, WORK)
CLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...