138 SUBROUTINE clattr( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B,
139 $ work, rwork, info )
147 CHARACTER diag, trans, uplo
148 INTEGER imat, info, lda, n
153 COMPLEX a( lda, * ),
b( * ), work( * )
160 parameter( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+0 )
166 INTEGER i, iy,
j, jcount, kl, ku, mode
167 REAL anorm, bignum, bnorm, bscal, c, cndnum, rexp,
168 $ sfac, smlnum, texp, tleft, tscal, ulp, unfl, x,
170 COMPLEX plus1, plus2, ra, rb, s, star1
184 INTRINSIC abs, cmplx, conjg, max,
REAL, sqrt
188 path( 1: 1 ) =
'Complex precision'
190 unfl =
slamch(
'Safe minimum' )
193 bignum = ( one-ulp ) / smlnum
194 CALL
slabad( smlnum, bignum )
195 IF( ( imat.GE.7 .AND. imat.LE.10 ) .OR. imat.EQ.18 )
THEN
209 upper =
lsame( uplo,
'U' )
211 CALL
clatb4( path, imat, n, n, type, kl, ku, anorm, mode,
214 CALL
clatb4( path, -imat, n, n, type, kl, ku, anorm, mode,
221 CALL
clatms( n, n, dist, iseed, type, rwork, mode, cndnum,
222 $ anorm, kl, ku,
'No packing', a, lda, work, info )
229 ELSE IF( imat.EQ.7 )
THEN
252 ELSE IF( imat.LE.10 )
THEN
327 star1 = 0.25*
clarnd( 5, iseed )
329 plus1 = sfac*
clarnd( 5, iseed )
331 plus2 = star1 / plus1
337 plus1 = star1 / plus2
339 IF( rexp.LT.zero )
THEN
340 star1 = -sfac**( one-rexp )*
clarnd( 5, iseed )
342 star1 = sfac**( one+rexp )*
clarnd( 5, iseed )
347 x = sqrt( cndnum ) - 1 / sqrt( cndnum )
349 y = sqrt( 2. / ( n-2 ) )*x
357 CALL
ccopy( n-3, work, 1, a( 2, 3 ), lda+1 )
359 $ CALL
ccopy( n-4, work( n+1 ), 1, a( 2, 4 ), lda+1 )
368 CALL
ccopy( n-3, work, 1, a( 3, 2 ), lda+1 )
370 $ CALL
ccopy( n-4, work( n+1 ), 1, a( 4, 2 ), lda+1 )
385 CALL
crotg( ra, rb, c, s )
390 $ CALL
crot( n-
j-1, a(
j,
j+2 ), lda, a(
j+1,
j+2 ),
396 $ CALL
crot(
j-1, a( 1,
j+1 ), 1, a( 1,
j ), 1, -c, -s )
400 a(
j,
j+1 ) = -a(
j,
j+1 )
406 CALL
crotg( ra, rb, c, s )
412 $ CALL
crot( n-
j-1, a(
j+2,
j+1 ), 1, a(
j+2,
j ), 1, c,
418 $ CALL
crot(
j-1, a(
j, 1 ), lda, a(
j+1, 1 ), lda, -c,
423 a(
j+1,
j ) = -a(
j+1,
j )
431 ELSE IF( imat.EQ.11 )
THEN
439 CALL
clarnv( 4, iseed,
j-1, a( 1,
j ) )
445 $ CALL
clarnv( 4, iseed, n-
j, a(
j+1,
j ) )
454 bnorm = abs(
b( iy ) )
455 bscal = bignum / max( one, bnorm )
458 ELSE IF( imat.EQ.12 )
THEN
465 tscal = one / max( one,
REAL( N-1 ) )
468 CALL
clarnv( 4, iseed,
j-1, a( 1,
j ) )
469 CALL
csscal(
j-1, tscal, a( 1,
j ), 1 )
472 a( n, n ) = smlnum*a( n, n )
476 CALL
clarnv( 4, iseed, n-
j, a(
j+1,
j ) )
477 CALL
csscal( n-
j, tscal, a(
j+1,
j ), 1 )
481 a( 1, 1 ) = smlnum*a( 1, 1 )
484 ELSE IF( imat.EQ.13 )
THEN
493 CALL
clarnv( 4, iseed,
j-1, a( 1,
j ) )
496 a( n, n ) = smlnum*a( n, n )
500 $ CALL
clarnv( 4, iseed, n-
j, a(
j+1,
j ) )
503 a( 1, 1 ) = smlnum*a( 1, 1 )
506 ELSE IF( imat.EQ.14 )
THEN
518 IF( jcount.LE.2 )
THEN
519 a(
j,
j ) = smlnum*
clarnd( 5, iseed )
533 IF( jcount.LE.2 )
THEN
534 a(
j,
j ) = smlnum*
clarnd( 5, iseed )
550 b( i-1 ) = smlnum*
clarnd( 5, iseed )
554 DO 250 i = 1, n - 1, 2
556 b( i+1 ) = smlnum*
clarnd( 5, iseed )
560 ELSE IF( imat.EQ.15 )
THEN
566 texp = one / max( one,
REAL( N-1 ) )
575 $ a(
j-1,
j ) = cmplx( -one, -one )
576 a(
j,
j ) = tscal*
clarnd( 5, iseed )
578 b( n ) = cmplx( one, one )
585 $ a(
j+1,
j ) = cmplx( -one, -one )
586 a(
j,
j ) = tscal*
clarnd( 5, iseed )
588 b( 1 ) = cmplx( one, one )
591 ELSE IF( imat.EQ.16 )
THEN
598 CALL
clarnv( 4, iseed,
j-1, a( 1,
j ) )
608 $ CALL
clarnv( 4, iseed, n-
j, a(
j+1,
j ) )
619 ELSE IF( imat.EQ.17 )
THEN
627 tscal = ( one-ulp ) / tscal
636 a( 1,
j ) = -tscal /
REAL( n+1 )
638 b(
j ) = texp*( one-ulp )
639 a( 1,
j-1 ) = -( tscal /
REAL( N+1 ) ) /
REAL( n+2 )
641 b(
j-1 ) = texp*
REAL( n*n+n-1 )
644 b( 1 ) = (
REAL( N+1 ) /
REAL( N+2 ) )*tscal
646 DO 350
j = 1, n - 1, 2
647 a( n,
j ) = -tscal /
REAL( n+1 )
649 b(
j ) = texp*( one-ulp )
650 a( n,
j+1 ) = -( tscal /
REAL( N+1 ) ) /
REAL( n+2 )
652 b(
j+1 ) = texp*
REAL( n*n+n-1 )
655 b( n ) = (
REAL( N+1 ) /
REAL( N+2 ) )*tscal
658 ELSE IF( imat.EQ.18 )
THEN
666 CALL
clarnv( 4, iseed,
j-1, a( 1,
j ) )
672 $ CALL
clarnv( 4, iseed, n-
j, a(
j+1,
j ) )
681 bnorm = abs(
b( iy ) )
682 bscal = bignum / max( one, bnorm )
685 ELSE IF( imat.EQ.19 )
THEN
692 tleft = bignum / max( one,
REAL( N-1 ) )
693 tscal = bignum*(
REAL( N-1 ) / max( one,
REAL( N ) ) )
696 CALL
clarnv( 5, iseed,
j, a( 1,
j ) )
697 CALL
slarnv( 1, iseed,
j, rwork )
699 a( i,
j ) = a( i,
j )*( tleft+rwork( i )*tscal )
704 CALL
clarnv( 5, iseed, n-
j+1, a(
j,
j ) )
705 CALL
slarnv( 1, iseed, n-
j+1, rwork )
707 a( i,
j ) = a( i,
j )*( tleft+rwork( i-
j+1 )*tscal )
717 IF( .NOT.
lsame( trans,
'N' ) )
THEN
720 CALL
cswap( n-2*
j+1, a(
j,
j ), lda, a(
j+1, n-
j+1 ),
725 CALL
cswap( n-2*
j+1, a(
j,
j ), 1, a( n-
j+1,
j+1 ),
subroutine crot(N, CX, INCX, CY, INCY, C, S)
CROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors...
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine crotg(CA, CB, C, S)
CROTG
subroutine clattr(IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, WORK, RWORK, INFO)
CLATTR
integer function icamax(N, CX, INCX)
ICAMAX
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
complex function clarnd(IDIST, ISEED)
CLARND
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
logical function lsame(CA, CB)
LSAME
real function slarnd(IDIST, ISEED)
SLARND
real function slamch(CMACH)
SLAMCH
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
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 ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine csscal(N, SA, CX, INCX)
CSSCAL