142 CHARACTER DIAG, TRANS, UPLO
143 INTEGER IMAT, INFO, LDA, N
147 REAL A( LDA, * ), B( * ), WORK( * )
154 parameter( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+0 )
160 INTEGER I, IY, J, JCOUNT, KL, KU, MODE
161 REAL ANORM, BIGNUM, BNORM, BSCAL, C, CNDNUM, PLUS1,
162 $ PLUS2, RA, RB, REXP, S, SFAC, SMLNUM, STAR1,
163 $ TEXP, TLEFT, TSCAL, ULP, UNFL, X, Y, Z
176 INTRINSIC abs, max, real, sign, sqrt
180 path( 1: 1 ) =
'Single precision'
182 unfl =
slamch(
'Safe minimum' )
185 bignum = ( one-ulp ) / smlnum
186 CALL slabad( smlnum, bignum )
187 IF( ( imat.GE.7 .AND. imat.LE.10 ) .OR. imat.EQ.18 )
THEN
201 upper =
lsame( uplo,
'U' )
203 CALL slatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
206 CALL slatb4( path, -imat, n, n,
TYPE, KL, KU, ANORM, MODE,
213 CALL slatms( n, n, dist, iseed,
TYPE, B, MODE, CNDNUM, ANORM,
214 $ KL, KU,
'No packing', A, LDA, WORK, INFO )
221 ELSE IF( imat.EQ.7 )
THEN
244 ELSE IF( imat.LE.10 )
THEN
323 plus2 = star1 / plus1
329 plus1 = star1 / plus2
331 star1 = star1*( sfac**rexp )
332 IF( rexp.LT.zero )
THEN
333 star1 = -sfac**( one-rexp )
335 star1 = sfac**( one+rexp )
340 x = sqrt( cndnum ) - 1 / sqrt( cndnum )
342 y = sqrt( 2. / ( n-2 ) )*x
350 CALL scopy( n-3, work, 1, a( 2, 3 ), lda+1 )
352 $
CALL scopy( n-4, work( n+1 ), 1, a( 2, 4 ), lda+1 )
361 CALL scopy( n-3, work, 1, a( 3, 2 ), lda+1 )
363 $
CALL scopy( n-4, work( n+1 ), 1, a( 4, 2 ), lda+1 )
378 CALL srotg( ra, rb, c, s )
383 $
CALL srot( n-j-1, a( j, j+2 ), lda, a( j+1, j+2 ),
389 $
CALL srot( j-1, a( 1, j+1 ), 1, a( 1, j ), 1, -c, -s )
393 a( j, j+1 ) = -a( j, j+1 )
399 CALL srotg( ra, rb, c, s )
404 $
CALL srot( n-j-1, a( j+2, j+1 ), 1, a( j+2, j ), 1, c,
410 $
CALL srot( j-1, a( j, 1 ), lda, a( j+1, 1 ), lda, -c,
415 a( j+1, j ) = -a( j+1, j )
423 ELSE IF( imat.EQ.11 )
THEN
431 CALL slarnv( 2, iseed, j, a( 1, j ) )
432 a( j, j ) = sign( two, a( j, j ) )
436 CALL slarnv( 2, iseed, n-j+1, a( j, j ) )
437 a( j, j ) = sign( two, a( j, j ) )
443 CALL slarnv( 2, iseed, n, b )
445 bnorm = abs( b( iy ) )
446 bscal = bignum / max( one, bnorm )
447 CALL sscal( n, bscal, b, 1 )
449 ELSE IF( imat.EQ.12 )
THEN
455 CALL slarnv( 2, iseed, n, b )
456 tscal = one / max( one, real( n-1 ) )
459 CALL slarnv( 2, iseed, j, a( 1, j ) )
460 CALL sscal( j-1, tscal, a( 1, j ), 1 )
461 a( j, j ) = sign( one, a( j, j ) )
463 a( n, n ) = smlnum*a( n, n )
466 CALL slarnv( 2, iseed, n-j+1, a( j, j ) )
468 $
CALL sscal( n-j, tscal, a( j+1, j ), 1 )
469 a( j, j ) = sign( one, a( j, j ) )
471 a( 1, 1 ) = smlnum*a( 1, 1 )
474 ELSE IF( imat.EQ.13 )
THEN
480 CALL slarnv( 2, iseed, n, b )
483 CALL slarnv( 2, iseed, j, a( 1, j ) )
484 a( j, j ) = sign( one, a( j, j ) )
486 a( n, n ) = smlnum*a( n, n )
489 CALL slarnv( 2, iseed, n-j+1, a( j, j ) )
490 a( j, j ) = sign( one, a( j, j ) )
492 a( 1, 1 ) = smlnum*a( 1, 1 )
495 ELSE IF( imat.EQ.14 )
THEN
507 IF( jcount.LE.2 )
THEN
522 IF( jcount.LE.2 )
THEN
543 DO 250 i = 1, n - 1, 2
549 ELSE IF( imat.EQ.15 )
THEN
555 texp = one / max( one, real( n-1 ) )
557 CALL slarnv( 2, iseed, n, b )
580 ELSE IF( imat.EQ.16 )
THEN
587 CALL slarnv( 2, iseed, j, a( 1, j ) )
589 a( j, j ) = sign( two, a( j, j ) )
596 CALL slarnv( 2, iseed, n-j+1, a( j, j ) )
598 a( j, j ) = sign( two, a( j, j ) )
604 CALL slarnv( 2, iseed, n, b )
605 CALL sscal( n, two, b, 1 )
607 ELSE IF( imat.EQ.17 )
THEN
615 tscal = ( one-ulp ) / tscal
624 a( 1, j ) = -tscal / real( n+1 )
626 b( j ) = texp*( one-ulp )
627 a( 1, j-1 ) = -( tscal / real( n+1 ) ) / real( n+2 )
629 b( j-1 ) = texp*real( n*n+n-1 )
632 b( 1 ) = ( real( n+1 ) / real( n+2 ) )*tscal
634 DO 350 j = 1, n - 1, 2
635 a( n, j ) = -tscal / real( n+1 )
637 b( j ) = texp*( one-ulp )
638 a( n, j+1 ) = -( tscal / real( n+1 ) ) / real( n+2 )
640 b( j+1 ) = texp*real( n*n+n-1 )
643 b( n ) = ( real( n+1 ) / real( n+2 ) )*tscal
646 ELSE IF( imat.EQ.18 )
THEN
654 CALL slarnv( 2, iseed, j-1, a( 1, j ) )
660 $
CALL slarnv( 2, iseed, n-j, a( j+1, j ) )
667 CALL slarnv( 2, iseed, n, b )
669 bnorm = abs( b( iy ) )
670 bscal = bignum / max( one, bnorm )
671 CALL sscal( n, bscal, b, 1 )
673 ELSE IF( imat.EQ.19 )
THEN
680 tleft = bignum / max( one, real( n-1 ) )
681 tscal = bignum*( real( n-1 ) / max( one, real( n ) ) )
684 CALL slarnv( 2, iseed, j, a( 1, j ) )
686 a( i, j ) = sign( tleft, a( i, j ) ) + tscal*a( i, j )
691 CALL slarnv( 2, iseed, n-j+1, a( j, j ) )
693 a( i, j ) = sign( tleft, a( i, j ) ) + tscal*a( i, j )
697 CALL slarnv( 2, iseed, n, b )
698 CALL sscal( n, two, b, 1 )
703 IF( .NOT.
lsame( trans,
'N' ) )
THEN
706 CALL sswap( n-2*j+1, a( j, j ), lda, a( j+1, n-j+1 ),
711 CALL sswap( n-2*j+1, a( j, j ), 1, a( n-j+1, j+1 ),