125 SUBROUTINE slattp( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, B, WORK,
134 CHARACTER DIAG, TRANS, UPLO
135 INTEGER IMAT, INFO, N
139 REAL A( * ), B( * ), WORK( * )
146 parameter( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+0 )
150 CHARACTER DIST, PACKIT, TYPE
152 INTEGER I, IY, J, JC, JCNEXT, JCOUNT, JJ, JL, JR, JX,
154 REAL ANORM, BIGNUM, BNORM, BSCAL, C, CNDNUM, PLUS1,
155 $ plus2, ra, rb, rexp, s, sfac, smlnum, star1,
156 $ stemp, t, texp, tleft, tscal, ulp, unfl, x, y,
163 EXTERNAL lsame, isamax, slamch, slarnd
170 INTRINSIC abs, max,
REAL, SIGN, SQRT
174 path( 1: 1 ) =
'Single precision'
176 unfl = slamch(
'Safe minimum' )
177 ulp = slamch(
'Epsilon' )*slamch(
'Base' )
179 bignum = ( one-ulp ) / smlnum
180 CALL
slabad( smlnum, bignum )
181 IF( ( imat.GE.7 .AND. imat.LE.10 ) .OR. imat.EQ.18 )
THEN
195 upper = lsame( uplo,
'U' )
197 CALL
slatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
201 CALL
slatb4( path, -imat, n, n,
TYPE, KL, KU, ANORM, MODE,
209 CALL
slatms( n, n, dist, iseed,
TYPE, B, MODE, CNDNUM, ANORM,
210 $ kl, ku, packit, a, n, work, info )
217 ELSE IF( imat.EQ.7 )
THEN
244 ELSE IF( imat.LE.10 )
THEN
327 plus2 = star1 / plus1
333 plus1 = star1 / plus2
334 rexp = slarnd( 2, iseed )
335 star1 = star1*( sfac**rexp )
336 IF( rexp.LT.zero )
THEN
337 star1 = -sfac**( one-rexp )
339 star1 = sfac**( one+rexp )
344 x = sqrt( cndnum ) - one / sqrt( cndnum )
346 y = sqrt( two /
REAL( N-2 ) )*x
361 $ a( jc+j-1 ) = work( j-2 )
363 $ a( jc+j-2 ) = work( n+j-3 )
382 a( jc+1 ) = work( j-1 )
384 $ a( jc+2 ) = work( n+j-1 )
398 CALL
srotg( ra, rb, c, s )
405 stemp = c*a( jx+j ) + s*a( jx+j+1 )
406 a( jx+j+1 ) = -s*a( jx+j ) + c*a( jx+j+1 )
415 $ CALL
srot( j-1, a( jcnext ), 1, a( jc ), 1, -c, -s )
419 a( jcnext+j-1 ) = -a( jcnext+j-1 )
425 jcnext = jc + n - j + 1
428 CALL
srotg( ra, rb, c, s )
433 $ CALL
srot( n-j-1, a( jcnext+1 ), 1, a( jc+2 ), 1, c,
441 stemp = -c*a( jx+j-i ) + s*a( jx+j-i+1 )
442 a( jx+j-i+1 ) = -s*a( jx+j-i ) - c*a( jx+j-i+1 )
450 a( jc+1 ) = -a( jc+1 )
459 ELSE IF( imat.EQ.11 )
THEN
468 CALL
slarnv( 2, iseed, j, a( jc ) )
469 a( jc+j-1 ) = sign( two, a( jc+j-1 ) )
475 CALL
slarnv( 2, iseed, n-j+1, a( jc ) )
476 a( jc ) = sign( two, a( jc ) )
483 CALL
slarnv( 2, iseed, n, b )
484 iy = isamax( n, b, 1 )
485 bnorm = abs( b( iy ) )
486 bscal = bignum / max( one, bnorm )
487 CALL
sscal( n, bscal, b, 1 )
489 ELSE IF( imat.EQ.12 )
THEN
495 CALL
slarnv( 2, iseed, n, b )
496 tscal = one / max( one,
REAL( N-1 ) )
500 CALL
slarnv( 2, iseed, j-1, a( jc ) )
501 CALL
sscal( j-1, tscal, a( jc ), 1 )
502 a( jc+j-1 ) = sign( one, slarnd( 2, iseed ) )
505 a( n*( n+1 ) / 2 ) = smlnum
509 CALL
slarnv( 2, iseed, n-j, a( jc+1 ) )
510 CALL
sscal( n-j, tscal, a( jc+1 ), 1 )
511 a( jc ) = sign( one, slarnd( 2, iseed ) )
517 ELSE IF( imat.EQ.13 )
THEN
523 CALL
slarnv( 2, iseed, n, b )
527 CALL
slarnv( 2, iseed, j-1, a( jc ) )
528 a( jc+j-1 ) = sign( one, slarnd( 2, iseed ) )
531 a( n*( n+1 ) / 2 ) = smlnum
535 CALL
slarnv( 2, iseed, n-j, a( jc+1 ) )
536 a( jc ) = sign( one, slarnd( 2, iseed ) )
542 ELSE IF( imat.EQ.14 )
THEN
550 jc = ( n-1 )*n / 2 + 1
555 IF( jcount.LE.2 )
THEN
572 IF( jcount.LE.2 )
THEN
594 DO 290 i = 1, n - 1, 2
600 ELSE IF( imat.EQ.15 )
THEN
606 texp = one / max( one,
REAL( N-1 ) )
608 CALL
slarnv( 2, iseed, n, b )
635 ELSE IF( imat.EQ.16 )
THEN
643 CALL
slarnv( 2, iseed, j, a( jc ) )
645 a( jc+j-1 ) = sign( two, a( jc+j-1 ) )
654 CALL
slarnv( 2, iseed, n-j+1, a( jc ) )
656 a( jc ) = sign( two, a( jc ) )
663 CALL
slarnv( 2, iseed, n, b )
664 CALL
sscal( n, two, b, 1 )
666 ELSE IF( imat.EQ.17 )
THEN
674 tscal = ( one-ulp ) / tscal
675 DO 360 j = 1, n*( n+1 ) / 2
680 jc = ( n-1 )*n / 2 + 1
682 a( jc ) = -tscal /
REAL( n+1 )
684 b( j ) = texp*( one-ulp )
686 a( jc ) = -( tscal /
REAL( N+1 ) ) /
REAL( N+2 )
688 b( j-1 ) = texp*
REAL( n*n+n-1 )
692 b( 1 ) = (
REAL( N+1 ) /
REAL( N+2 ) )*tscal
695 DO 380 j = 1, n - 1, 2
696 a( jc+n-j ) = -tscal /
REAL( n+1 )
698 b( j ) = texp*( one-ulp )
700 a( jc+n-j-1 ) = -( tscal /
REAL( N+1 ) ) /
REAL( N+2 )
702 b( j+1 ) = texp*
REAL( n*n+n-1 )
706 b( n ) = (
REAL( N+1 ) /
REAL( N+2 ) )*tscal
709 ELSE IF( imat.EQ.18 )
THEN
718 CALL
slarnv( 2, iseed, j-1, a( jc ) )
726 $ CALL
slarnv( 2, iseed, n-j, a( jc+1 ) )
734 CALL
slarnv( 2, iseed, n, b )
735 iy = isamax( n, b, 1 )
736 bnorm = abs( b( iy ) )
737 bscal = bignum / max( one, bnorm )
738 CALL
sscal( n, bscal, b, 1 )
740 ELSE IF( imat.EQ.19 )
THEN
746 tleft = bignum / max( one,
REAL( N-1 ) )
747 tscal = bignum*(
REAL( N-1 ) / MAX( one,
REAL( N ) ) )
751 CALL
slarnv( 2, iseed, j, a( jc ) )
753 a( jc+i-1 ) = sign( tleft, a( jc+i-1 ) ) +
761 CALL
slarnv( 2, iseed, n-j+1, a( jc ) )
763 a( jc+i-j ) = sign( tleft, a( jc+i-j ) ) +
769 CALL
slarnv( 2, iseed, n, b )
770 CALL
sscal( n, two, b, 1 )
776 IF( .NOT.lsame( trans,
'N' ) )
THEN
784 a( jr-i+j ) = a( jl )
798 a( jl+i-j ) = a( jr )
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
subroutine slattp(IMAT, UPLO, TRANS, DIAG, ISEED, N, A, B, WORK, INFO)
SLATTP
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine srotg(SA, SB, C, S)
SROTG
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine srot(N, SX, INCX, SY, INCY, C, S)
SROT