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
177 EXTERNAL lsame, icamax, slamch, slarnd, clarnd
184 INTRINSIC abs, cmplx, conjg, max,
REAL, SQRT
188 path( 1: 1 ) =
'Complex precision'
190 unfl = slamch(
'Safe minimum' )
191 ulp = slamch(
'Epsilon' )*slamch(
'Base' )
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
338 rexp = slarnd( 2, iseed )
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 ) )
440 a( j, j ) = clarnd( 5, iseed )*two
445 $ CALL
clarnv( 4, iseed, n-j, a( j+1, j ) )
446 a( j, j ) = clarnd( 5, iseed )*two
452 CALL
clarnv( 2, iseed, n, b )
453 iy = icamax( n, b, 1 )
454 bnorm = abs( b( iy ) )
455 bscal = bignum / max( one, bnorm )
456 CALL
csscal( n, bscal, b, 1 )
458 ELSE IF( imat.EQ.12 )
THEN
464 CALL
clarnv( 2, iseed, n, b )
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 )
470 a( j, j ) = clarnd( 5, iseed )
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 )
479 a( j, j ) = clarnd( 5, iseed )
481 a( 1, 1 ) = smlnum*a( 1, 1 )
484 ELSE IF( imat.EQ.13 )
THEN
490 CALL
clarnv( 2, iseed, n, b )
493 CALL
clarnv( 4, iseed, j-1, a( 1, j ) )
494 a( j, j ) = clarnd( 5, iseed )
496 a( n, n ) = smlnum*a( n, n )
500 $ CALL
clarnv( 4, iseed, n-j, a( j+1, j ) )
501 a( j, j ) = clarnd( 5, iseed )
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 )
521 a( j, j ) = clarnd( 5, iseed )
533 IF( jcount.LE.2 )
THEN
534 a( j, j ) = smlnum*clarnd( 5, iseed )
536 a( j, j ) = 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 ) )
568 CALL
clarnv( 4, iseed, n, b )
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 ) )
600 a( j, j ) = clarnd( 5, iseed )*two
608 $ CALL
clarnv( 4, iseed, n-j, a( j+1, j ) )
610 a( j, j ) = clarnd( 5, iseed )*two
616 CALL
clarnv( 2, iseed, n, b )
617 CALL
csscal( n, two, b, 1 )
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 ) )
679 CALL
clarnv( 2, iseed, n, b )
680 iy = icamax( n, b, 1 )
681 bnorm = abs( b( iy ) )
682 bscal = bignum / max( one, bnorm )
683 CALL
csscal( n, bscal, b, 1 )
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 )
711 CALL
clarnv( 2, iseed, n, b )
712 CALL
csscal( n, two, b, 1 )
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
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.
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine csscal(N, SA, CX, INCX)
CSSCAL