140 CHARACTER diag, trans, uplo
141 INTEGER imat, info, n
145 DOUBLE PRECISION rwork( * )
146 COMPLEX*16 ap( * ), b( * ), work( * )
152 DOUBLE PRECISION one, two, zero
153 parameter ( one = 1.0d+0, two = 2.0d+0, zero = 0.0d+0 )
157 CHARACTER dist, packit, type
159 INTEGER i, iy, j, jc, jcnext, jcount, jj, jl, jr, jx,
161 DOUBLE PRECISION anorm, bignum, bnorm, bscal, c, cndnum, rexp,
162 $ sfac, smlnum, t, texp, tleft, tscal, ulp, unfl,
164 COMPLEX*16 ctemp, plus1, plus2, ra, rb, s, star1
178 INTRINSIC abs, dble, dcmplx, dconjg, max, sqrt
182 path( 1: 1 ) =
'Zomplex precision'
184 unfl =
dlamch(
'Safe minimum' )
187 bignum = ( one-ulp ) / smlnum
188 CALL dlabad( smlnum, bignum )
189 IF( ( imat.GE.7 .AND. imat.LE.10 ) .OR. imat.EQ.18 )
THEN
203 upper =
lsame( uplo,
'U' )
205 CALL zlatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
209 CALL zlatb4( path, -imat, n, n,
TYPE, kl, ku, anorm, mode,
217 CALL zlatms( n, n, dist, iseed,
TYPE, rwork, mode, cndnum,
218 $ anorm, kl, ku, packit, ap, n, work, info )
225 ELSE IF( imat.EQ.7 )
THEN
252 ELSE IF( imat.LE.10 )
THEN
331 star1 = 0.25d0*
zlarnd( 5, iseed )
333 plus1 = sfac*
zlarnd( 5, iseed )
335 plus2 = star1 / plus1
341 plus1 = star1 / plus2
343 IF( rexp.LT.zero )
THEN
344 star1 = -sfac**( one-rexp )*
zlarnd( 5, iseed )
346 star1 = sfac**( one+rexp )*
zlarnd( 5, iseed )
351 x = sqrt( cndnum ) - one / sqrt( cndnum )
353 y = sqrt( two / dble( n-2 ) )*x
368 $ ap( jc+j-1 ) = work( j-2 )
370 $ ap( jc+j-2 ) = work( n+j-3 )
389 ap( jc+1 ) = work( j-1 )
391 $ ap( jc+2 ) = work( n+j-1 )
403 ra = ap( jcnext+j-1 )
405 CALL zrotg( ra, rb, c, s )
412 ctemp = c*ap( jx+j ) + s*ap( jx+j+1 )
413 ap( jx+j+1 ) = -dconjg( s )*ap( jx+j ) +
423 $
CALL zrot( j-1, ap( jcnext ), 1, ap( jc ), 1, -c, -s )
427 ap( jcnext+j-1 ) = -ap( jcnext+j-1 )
433 jcnext = jc + n - j + 1
436 CALL zrotg( ra, rb, c, s )
442 $
CALL zrot( n-j-1, ap( jcnext+1 ), 1, ap( jc+2 ), 1, c,
450 ctemp = -c*ap( jx+j-i ) + s*ap( jx+j-i+1 )
451 ap( jx+j-i+1 ) = -dconjg( s )*ap( jx+j-i ) -
460 ap( jc+1 ) = -ap( jc+1 )
469 ELSE IF( imat.EQ.11 )
THEN
478 CALL zlarnv( 4, iseed, j-1, ap( jc ) )
479 ap( jc+j-1 ) =
zlarnd( 5, iseed )*two
486 $
CALL zlarnv( 4, iseed, n-j, ap( jc+1 ) )
487 ap( jc ) =
zlarnd( 5, iseed )*two
494 CALL zlarnv( 2, iseed, n, b )
496 bnorm = abs( b( iy ) )
497 bscal = bignum / max( one, bnorm )
498 CALL zdscal( n, bscal, b, 1 )
500 ELSE IF( imat.EQ.12 )
THEN
506 CALL zlarnv( 2, iseed, n, b )
507 tscal = one / max( one, dble( n-1 ) )
511 CALL zlarnv( 4, iseed, j-1, ap( jc ) )
512 CALL zdscal( j-1, tscal, ap( jc ), 1 )
513 ap( jc+j-1 ) =
zlarnd( 5, iseed )
516 ap( n*( n+1 ) / 2 ) = smlnum*ap( n*( n+1 ) / 2 )
520 CALL zlarnv( 2, iseed, n-j, ap( jc+1 ) )
521 CALL zdscal( n-j, tscal, ap( jc+1 ), 1 )
522 ap( jc ) =
zlarnd( 5, iseed )
525 ap( 1 ) = smlnum*ap( 1 )
528 ELSE IF( imat.EQ.13 )
THEN
534 CALL zlarnv( 2, iseed, n, b )
538 CALL zlarnv( 4, iseed, j-1, ap( jc ) )
539 ap( jc+j-1 ) =
zlarnd( 5, iseed )
542 ap( n*( n+1 ) / 2 ) = smlnum*ap( n*( n+1 ) / 2 )
546 CALL zlarnv( 4, iseed, n-j, ap( jc+1 ) )
547 ap( jc ) =
zlarnd( 5, iseed )
550 ap( 1 ) = smlnum*ap( 1 )
553 ELSE IF( imat.EQ.14 )
THEN
561 jc = ( n-1 )*n / 2 + 1
566 IF( jcount.LE.2 )
THEN
567 ap( jc+j-1 ) = smlnum*
zlarnd( 5, iseed )
569 ap( jc+j-1 ) =
zlarnd( 5, iseed )
583 IF( jcount.LE.2 )
THEN
584 ap( jc ) = smlnum*
zlarnd( 5, iseed )
586 ap( jc ) =
zlarnd( 5, iseed )
601 b( i-1 ) = smlnum*
zlarnd( 5, iseed )
605 DO 290 i = 1, n - 1, 2
607 b( i+1 ) = smlnum*
zlarnd( 5, iseed )
611 ELSE IF( imat.EQ.15 )
THEN
617 texp = one / max( one, dble( n-1 ) )
619 CALL zlarnv( 4, iseed, n, b )
627 $ ap( jc+j-2 ) = dcmplx( -one, -one )
628 ap( jc+j-1 ) = tscal*
zlarnd( 5, iseed )
631 b( n ) = dcmplx( one, one )
639 $ ap( jc+1 ) = dcmplx( -one, -one )
640 ap( jc ) = tscal*
zlarnd( 5, iseed )
643 b( 1 ) = dcmplx( one, one )
646 ELSE IF( imat.EQ.16 )
THEN
654 CALL zlarnv( 4, iseed, j, ap( jc ) )
656 ap( jc+j-1 ) =
zlarnd( 5, iseed )*two
665 CALL zlarnv( 4, iseed, n-j+1, ap( jc ) )
667 ap( jc ) =
zlarnd( 5, iseed )*two
674 CALL zlarnv( 2, iseed, n, b )
675 CALL zdscal( n, two, b, 1 )
677 ELSE IF( imat.EQ.17 )
THEN
685 tscal = ( one-ulp ) / tscal
686 DO 360 j = 1, n*( n+1 ) / 2
691 jc = ( n-1 )*n / 2 + 1
693 ap( jc ) = -tscal / dble( n+1 )
695 b( j ) = texp*( one-ulp )
697 ap( jc ) = -( tscal / dble( n+1 ) ) / dble( n+2 )
699 b( j-1 ) = texp*dble( n*n+n-1 )
703 b( 1 ) = ( dble( n+1 ) / dble( n+2 ) )*tscal
706 DO 380 j = 1, n - 1, 2
707 ap( jc+n-j ) = -tscal / dble( n+1 )
709 b( j ) = texp*( one-ulp )
711 ap( jc+n-j-1 ) = -( tscal / dble( n+1 ) ) / dble( n+2 )
713 b( j+1 ) = texp*dble( n*n+n-1 )
717 b( n ) = ( dble( n+1 ) / dble( n+2 ) )*tscal
720 ELSE IF( imat.EQ.18 )
THEN
729 CALL zlarnv( 4, iseed, j-1, ap( jc ) )
737 $
CALL zlarnv( 4, iseed, n-j, ap( jc+1 ) )
745 CALL zlarnv( 2, iseed, n, b )
747 bnorm = abs( b( iy ) )
748 bscal = bignum / max( one, bnorm )
749 CALL zdscal( n, bscal, b, 1 )
751 ELSE IF( imat.EQ.19 )
THEN
758 tleft = bignum / max( one, dble( n-1 ) )
759 tscal = bignum*( dble( n-1 ) / max( one, dble( n ) ) )
763 CALL zlarnv( 5, iseed, j, ap( jc ) )
764 CALL dlarnv( 1, iseed, j, rwork )
766 ap( jc+i-1 ) = ap( jc+i-1 )*( tleft+rwork( i )*tscal )
773 CALL zlarnv( 5, iseed, n-j+1, ap( jc ) )
774 CALL dlarnv( 1, iseed, n-j+1, rwork )
776 ap( jc+i-j ) = ap( jc+i-j )*
777 $ ( tleft+rwork( i-j+1 )*tscal )
782 CALL zlarnv( 2, iseed, n, b )
783 CALL zdscal( n, two, b, 1 )
789 IF( .NOT.
lsame( trans,
'N' ) )
THEN
797 ap( jr-i+j ) = ap( jl )
811 ap( jl+i-j ) = ap( jr )
double precision function dlamch(CMACH)
DLAMCH
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 dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
integer function izamax(N, ZX, INCX)
IZAMAX
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
logical function lsame(CA, CB)
LSAME
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine zrotg(CA, CB, C, S)
ZROTG
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
complex *16 function zlarnd(IDIST, ISEED)
ZLARND