144 CHARACTER DIAG, TRANS, UPLO
145 INTEGER IMAT, INFO, KD, LDAB, N
149 REAL AB( LDAB, * ), B( * ), WORK( * )
156 parameter( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+0 )
160 CHARACTER DIST, PACKIT, TYPE
162 INTEGER I, IOFF, IY, J, JCOUNT, KL, KU, LENJ, MODE
163 REAL ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, PLUS1,
164 $ PLUS2, REXP, SFAC, SMLNUM, STAR1, TEXP, TLEFT,
165 $ TNORM, TSCAL, ULP, UNFL
178 INTRINSIC abs, max, min, real, sign, sqrt
182 path( 1: 1 ) =
'Single precision'
184 unfl =
slamch(
'Safe minimum' )
187 bignum = ( one-ulp ) / smlnum
188 CALL slabad( smlnum, bignum )
189 IF( ( imat.GE.6 .AND. imat.LE.9 ) .OR. imat.EQ.17 )
THEN
203 upper =
lsame( uplo,
'U' )
205 CALL slatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
208 ioff = 1 + max( 0, kd-n+1 )
212 CALL slatb4( path, -imat, n, n,
TYPE, KL, KU, ANORM, MODE,
223 CALL slatms( n, n, dist, iseed,
TYPE, B, MODE, CNDNUM, ANORM,
224 $ KL, KU, PACKIT, AB( IOFF, 1 ), LDAB, WORK, INFO )
231 ELSE IF( imat.EQ.6 )
THEN
234 DO 10 i = max( 1, kd+2-j ), kd
242 DO 30 i = 2, min( kd+1, n-j+1 )
253 ELSE IF( imat.LE.9 )
THEN
254 tnorm = sqrt( cndnum )
260 DO 50 i = max( 1, kd+2-j ), kd
263 ab( kd+1, j ) = real( j )
267 DO 70 i = 2, min( kd+1, n-j+1 )
270 ab( 1, j ) = real( j )
279 ab( 1, 2 ) = sign( tnorm,
slarnd( 2, iseed ) )
281 CALL slarnv( 2, iseed, lenj, work )
283 ab( 1, 2*( j+1 ) ) = tnorm*work( j )
286 ab( 2, 1 ) = sign( tnorm,
slarnd( 2, iseed ) )
288 CALL slarnv( 2, iseed, lenj, work )
290 ab( 2, 2*j+1 ) = tnorm*work( j )
293 ELSE IF( kd.GT.1 )
THEN
311 star1 = sign( tnorm,
slarnd( 2, iseed ) )
313 plus1 = sign( sfac,
slarnd( 2, iseed ) )
315 plus2 = star1 / plus1
321 plus1 = star1 / plus2
327 IF( rexp.LT.zero )
THEN
328 star1 = -sfac**( one-rexp )
330 star1 = sfac**( one+rexp )
338 CALL scopy( n-1, work, 1, ab( kd, 2 ), ldab )
339 CALL scopy( n-2, work( n+1 ), 1, ab( kd-1, 3 ), ldab )
341 CALL scopy( n-1, work, 1, ab( 2, 1 ), ldab )
342 CALL scopy( n-2, work( n+1 ), 1, ab( 3, 1 ), ldab )
350 ELSE IF( imat.EQ.10 )
THEN
358 lenj = min( j, kd+1 )
359 CALL slarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
360 ab( kd+1, j ) = sign( two, ab( kd+1, j ) )
364 lenj = min( n-j+1, kd+1 )
366 $
CALL slarnv( 2, iseed, lenj, ab( 1, j ) )
367 ab( 1, j ) = sign( two, ab( 1, j ) )
373 CALL slarnv( 2, iseed, n, b )
375 bnorm = abs( b( iy ) )
376 bscal = bignum / max( one, bnorm )
377 CALL sscal( n, bscal, b, 1 )
379 ELSE IF( imat.EQ.11 )
THEN
385 CALL slarnv( 2, iseed, n, b )
386 tscal = one / real( kd+1 )
389 lenj = min( j, kd+1 )
390 CALL slarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
391 CALL sscal( lenj-1, tscal, ab( kd+2-lenj, j ), 1 )
392 ab( kd+1, j ) = sign( one, ab( kd+1, j ) )
394 ab( kd+1, n ) = smlnum*ab( kd+1, n )
397 lenj = min( n-j+1, kd+1 )
398 CALL slarnv( 2, iseed, lenj, ab( 1, j ) )
400 $
CALL sscal( lenj-1, tscal, ab( 2, j ), 1 )
401 ab( 1, j ) = sign( one, ab( 1, j ) )
403 ab( 1, 1 ) = smlnum*ab( 1, 1 )
406 ELSE IF( imat.EQ.12 )
THEN
412 CALL slarnv( 2, iseed, n, b )
415 lenj = min( j, kd+1 )
416 CALL slarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
417 ab( kd+1, j ) = sign( one, ab( kd+1, j ) )
419 ab( kd+1, n ) = smlnum*ab( kd+1, n )
422 lenj = min( n-j+1, kd+1 )
423 CALL slarnv( 2, iseed, lenj, ab( 1, j ) )
424 ab( 1, j ) = sign( one, ab( 1, j ) )
426 ab( 1, 1 ) = smlnum*ab( 1, 1 )
429 ELSE IF( imat.EQ.13 )
THEN
438 DO 180 i = max( 1, kd+1-( j-1 ) ), kd
441 IF( jcount.LE.2 )
THEN
442 ab( kd+1, j ) = smlnum
453 DO 200 i = 2, min( n-j+1, kd+1 )
456 IF( jcount.LE.2 )
THEN
477 DO 230 i = 1, n - 1, 2
483 ELSE IF( imat.EQ.14 )
THEN
489 texp = one / real( kd+1 )
491 CALL slarnv( 2, iseed, n, b )
494 DO 240 i = max( 1, kd+2-j ), kd
497 IF( j.GT.1 .AND. kd.GT.0 )
499 ab( kd+1, j ) = tscal
504 DO 260 i = 3, min( n-j+1, kd+1 )
507 IF( j.LT.n .AND. kd.GT.0 )
514 ELSE IF( imat.EQ.15 )
THEN
521 lenj = min( j, kd+1 )
522 CALL slarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
524 ab( kd+1, j ) = sign( two, ab( kd+1, j ) )
531 lenj = min( n-j+1, kd+1 )
532 CALL slarnv( 2, iseed, lenj, ab( 1, j ) )
534 ab( 1, j ) = sign( two, ab( 1, j ) )
540 CALL slarnv( 2, iseed, n, b )
541 CALL sscal( n, two, b, 1 )
543 ELSE IF( imat.EQ.16 )
THEN
551 tscal = ( one-ulp ) / tscal
561 DO 320 i = j, max( 1, j-kd+1 ), -2
562 ab( 1+( j-i ), i ) = -tscal / real( kd+2 )
564 b( i ) = texp*( one-ulp )
565 IF( i.GT.max( 1, j-kd+1 ) )
THEN
566 ab( 2+( j-i ), i-1 ) = -( tscal / real( kd+2 ) )
568 ab( kd+1, i-1 ) = one
569 b( i-1 ) = texp*real( ( kd+1 )*( kd+1 )+kd )
573 b( max( 1, j-kd+1 ) ) = ( real( kd+2 ) /
574 $ real( kd+3 ) )*tscal
579 lenj = min( kd+1, n-j+1 )
580 DO 340 i = j, min( n, j+kd-1 ), 2
581 ab( lenj-( i-j ), j ) = -tscal / real( kd+2 )
583 b( j ) = texp*( one-ulp )
584 IF( i.LT.min( n, j+kd-1 ) )
THEN
585 ab( lenj-( i-j+1 ), i+1 ) = -( tscal /
586 $ real( kd+2 ) ) / real( kd+3 )
588 b( i+1 ) = texp*real( ( kd+1 )*( kd+1 )+kd )
592 b( min( n, j+kd-1 ) ) = ( real( kd+2 ) /
593 $ real( kd+3 ) )*tscal
603 ELSE IF( imat.EQ.17 )
THEN
611 lenj = min( j-1, kd )
612 CALL slarnv( 2, iseed, lenj, ab( kd+1-lenj, j ) )
613 ab( kd+1, j ) = real( j )
617 lenj = min( n-j, kd )
619 $
CALL slarnv( 2, iseed, lenj, ab( 2, j ) )
620 ab( 1, j ) = real( j )
626 CALL slarnv( 2, iseed, n, b )
628 bnorm = abs( b( iy ) )
629 bscal = bignum / max( one, bnorm )
630 CALL sscal( n, bscal, b, 1 )
632 ELSE IF( imat.EQ.18 )
THEN
638 tleft = bignum / max( one, real( kd ) )
639 tscal = bignum*( real( kd ) / real( kd+1 ) )
642 lenj = min( j, kd+1 )
643 CALL slarnv( 2, iseed, lenj, ab( kd+2-lenj, j ) )
644 DO 390 i = kd + 2 - lenj, kd + 1
645 ab( i, j ) = sign( tleft, ab( i, j ) ) +
651 lenj = min( n-j+1, kd+1 )
652 CALL slarnv( 2, iseed, lenj, ab( 1, j ) )
654 ab( i, j ) = sign( tleft, ab( i, j ) ) +
659 CALL slarnv( 2, iseed, n, b )
660 CALL sscal( n, two, b, 1 )
665 IF( .NOT.
lsame( trans,
'N' ) )
THEN
668 lenj = min( n-2*j+1, kd+1 )
669 CALL sswap( lenj, ab( kd+1, j ), ldab-1,
670 $ ab( kd+2-lenj, n-j+1 ), -1 )
674 lenj = min( n-2*j+1, kd+1 )
675 CALL sswap( lenj, ab( 1, j ), 1, ab( lenj, n-j+2-lenj ),