138 SUBROUTINE zlattr( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B,
139 $ work, rwork, info )
147 CHARACTER DIAG, TRANS, UPLO
148 INTEGER IMAT, INFO, LDA, N
152 DOUBLE PRECISION RWORK( * )
153 COMPLEX*16 A( lda, * ), B( * ), WORK( * )
159 DOUBLE PRECISION ONE, TWO, ZERO
160 parameter( one = 1.0d+0, two = 2.0d+0, zero = 0.0d+0 )
166 INTEGER I, IY, J, JCOUNT, KL, KU, MODE
167 DOUBLE PRECISION ANORM, BIGNUM, BNORM, BSCAL, C, CNDNUM, REXP,
168 $ sfac, smlnum, texp, tleft, tscal, ulp, unfl, x,
170 COMPLEX*16 PLUS1, PLUS2, RA, RB, S, STAR1
175 DOUBLE PRECISION DLAMCH, DLARND
177 EXTERNAL lsame, izamax, dlamch, dlarnd, zlarnd
184 INTRINSIC abs, dble, dcmplx, dconjg, max, sqrt
188 path( 1: 1 ) =
'Zomplex precision'
190 unfl = dlamch(
'Safe minimum' )
191 ulp = dlamch(
'Epsilon' )*dlamch(
'Base' )
193 bignum = ( one-ulp ) / smlnum
194 CALL
dlabad( smlnum, bignum )
195 IF( ( imat.GE.7 .AND. imat.LE.10 ) .OR. imat.EQ.18 )
THEN
209 upper = lsame( uplo,
'U' )
211 CALL
zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
214 CALL
zlatb4( path, -imat, n, n,
TYPE, KL, KU, ANORM, MODE,
221 CALL
zlatms( 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.25d0*zlarnd( 5, iseed )
329 plus1 = sfac*zlarnd( 5, iseed )
331 plus2 = star1 / plus1
337 plus1 = star1 / plus2
338 rexp = dlarnd( 2, iseed )
339 IF( rexp.LT.zero )
THEN
340 star1 = -sfac**( one-rexp )*zlarnd( 5, iseed )
342 star1 = sfac**( one+rexp )*zlarnd( 5, iseed )
347 x = sqrt( cndnum ) - 1 / sqrt( cndnum )
349 y = sqrt( 2.d0 / ( n-2 ) )*x
357 CALL
zcopy( n-3, work, 1, a( 2, 3 ), lda+1 )
359 $ CALL
zcopy( n-4, work( n+1 ), 1, a( 2, 4 ), lda+1 )
368 CALL
zcopy( n-3, work, 1, a( 3, 2 ), lda+1 )
370 $ CALL
zcopy( n-4, work( n+1 ), 1, a( 4, 2 ), lda+1 )
385 CALL
zrotg( ra, rb, c, s )
390 $ CALL
zrot( n-j-1, a( j, j+2 ), lda, a( j+1, j+2 ),
396 $ CALL
zrot( j-1, a( 1, j+1 ), 1, a( 1, j ), 1, -c, -s )
400 a( j, j+1 ) = -a( j, j+1 )
406 CALL
zrotg( ra, rb, c, s )
412 $ CALL
zrot( n-j-1, a( j+2, j+1 ), 1, a( j+2, j ), 1, c,
418 $ CALL
zrot( 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
zlarnv( 4, iseed, j-1, a( 1, j ) )
440 a( j, j ) = zlarnd( 5, iseed )*two
445 $ CALL
zlarnv( 4, iseed, n-j, a( j+1, j ) )
446 a( j, j ) = zlarnd( 5, iseed )*two
452 CALL
zlarnv( 2, iseed, n, b )
453 iy = izamax( n, b, 1 )
454 bnorm = abs( b( iy ) )
455 bscal = bignum / max( one, bnorm )
456 CALL
zdscal( n, bscal, b, 1 )
458 ELSE IF( imat.EQ.12 )
THEN
464 CALL
zlarnv( 2, iseed, n, b )
465 tscal = one / max( one, dble( n-1 ) )
468 CALL
zlarnv( 4, iseed, j-1, a( 1, j ) )
469 CALL
zdscal( j-1, tscal, a( 1, j ), 1 )
470 a( j, j ) = zlarnd( 5, iseed )
472 a( n, n ) = smlnum*a( n, n )
476 CALL
zlarnv( 4, iseed, n-j, a( j+1, j ) )
477 CALL
zdscal( n-j, tscal, a( j+1, j ), 1 )
479 a( j, j ) = zlarnd( 5, iseed )
481 a( 1, 1 ) = smlnum*a( 1, 1 )
484 ELSE IF( imat.EQ.13 )
THEN
490 CALL
zlarnv( 2, iseed, n, b )
493 CALL
zlarnv( 4, iseed, j-1, a( 1, j ) )
494 a( j, j ) = zlarnd( 5, iseed )
496 a( n, n ) = smlnum*a( n, n )
500 $ CALL
zlarnv( 4, iseed, n-j, a( j+1, j ) )
501 a( j, j ) = zlarnd( 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*zlarnd( 5, iseed )
521 a( j, j ) = zlarnd( 5, iseed )
533 IF( jcount.LE.2 )
THEN
534 a( j, j ) = smlnum*zlarnd( 5, iseed )
536 a( j, j ) = zlarnd( 5, iseed )
550 b( i-1 ) = smlnum*zlarnd( 5, iseed )
554 DO 250 i = 1, n - 1, 2
556 b( i+1 ) = smlnum*zlarnd( 5, iseed )
560 ELSE IF( imat.EQ.15 )
THEN
566 texp = one / max( one, dble( n-1 ) )
568 CALL
zlarnv( 4, iseed, n, b )
575 $ a( j-1, j ) = dcmplx( -one, -one )
576 a( j, j ) = tscal*zlarnd( 5, iseed )
578 b( n ) = dcmplx( one, one )
585 $ a( j+1, j ) = dcmplx( -one, -one )
586 a( j, j ) = tscal*zlarnd( 5, iseed )
588 b( 1 ) = dcmplx( one, one )
591 ELSE IF( imat.EQ.16 )
THEN
598 CALL
zlarnv( 4, iseed, j-1, a( 1, j ) )
600 a( j, j ) = zlarnd( 5, iseed )*two
608 $ CALL
zlarnv( 4, iseed, n-j, a( j+1, j ) )
610 a( j, j ) = zlarnd( 5, iseed )*two
616 CALL
zlarnv( 2, iseed, n, b )
617 CALL
zdscal( n, two, b, 1 )
619 ELSE IF( imat.EQ.17 )
THEN
627 tscal = ( one-ulp ) / tscal
636 a( 1, j ) = -tscal / dble( n+1 )
638 b( j ) = texp*( one-ulp )
639 a( 1, j-1 ) = -( tscal / dble( n+1 ) ) / dble( n+2 )
641 b( j-1 ) = texp*dble( n*n+n-1 )
644 b( 1 ) = ( dble( n+1 ) / dble( n+2 ) )*tscal
646 DO 350 j = 1, n - 1, 2
647 a( n, j ) = -tscal / dble( n+1 )
649 b( j ) = texp*( one-ulp )
650 a( n, j+1 ) = -( tscal / dble( n+1 ) ) / dble( n+2 )
652 b( j+1 ) = texp*dble( n*n+n-1 )
655 b( n ) = ( dble( n+1 ) / dble( n+2 ) )*tscal
658 ELSE IF( imat.EQ.18 )
THEN
666 CALL
zlarnv( 4, iseed, j-1, a( 1, j ) )
672 $ CALL
zlarnv( 4, iseed, n-j, a( j+1, j ) )
679 CALL
zlarnv( 2, iseed, n, b )
680 iy = izamax( n, b, 1 )
681 bnorm = abs( b( iy ) )
682 bscal = bignum / max( one, bnorm )
683 CALL
zdscal( n, bscal, b, 1 )
685 ELSE IF( imat.EQ.19 )
THEN
692 tleft = bignum / max( one, dble( n-1 ) )
693 tscal = bignum*( dble( n-1 ) / max( one, dble( n ) ) )
696 CALL
zlarnv( 5, iseed, j, a( 1, j ) )
697 CALL
dlarnv( 1, iseed, j, rwork )
699 a( i, j ) = a( i, j )*( tleft+rwork( i )*tscal )
704 CALL
zlarnv( 5, iseed, n-j+1, a( j, j ) )
705 CALL
dlarnv( 1, iseed, n-j+1, rwork )
707 a( i, j ) = a( i, j )*( tleft+rwork( i-j+1 )*tscal )
711 CALL
zlarnv( 2, iseed, n, b )
712 CALL
zdscal( n, two, b, 1 )
717 IF( .NOT.lsame( trans,
'N' ) )
THEN
720 CALL zswap( n-2*j+1, a( j, j ), lda, a( j+1, n-j+1 ),
725 CALL zswap( n-2*j+1, a( j, j ), 1, a( n-j+1, j+1 ),
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine zrotg(CA, CB, C, S)
ZROTG
subroutine zrot(N, CX, INCX, CY, INCY, C, S)
ZROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors...
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zlattr(IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, WORK, RWORK, INFO)
ZLATTR
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4