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,
170 INTRINSIC abs, max,
REAL, sign, sqrt
174 path( 1: 1 ) =
'Single precision'
176 unfl =
slamch(
'Safe minimum' )
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
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 ) )
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
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
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 ) )
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 ) )
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 ) )
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 ) ) +
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 )
integer function isamax(N, SX, INCX)
ISAMAX
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
real function slarnd(IDIST, ISEED)
SLARND
real function slamch(CMACH)
SLAMCH
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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