137 CHARACTER DIAG, TRANS, UPLO
138 INTEGER IMAT, INFO, N
142 DOUBLE PRECISION RWORK( * )
143 COMPLEX*16 AP( * ), B( * ), WORK( * )
149 DOUBLE PRECISION ONE, TWO, ZERO
150 parameter( one = 1.0d+0, two = 2.0d+0, zero = 0.0d+0 )
154 CHARACTER DIST, PACKIT, TYPE
156 INTEGER I, IY, J, JC, JCNEXT, JCOUNT, JJ, JL, JR, JX,
158 DOUBLE PRECISION ANORM, BIGNUM, BNORM, BSCAL, C, CNDNUM, REXP,
159 $ SFAC, SMLNUM, T, TEXP, TLEFT, TSCAL, ULP, UNFL,
161 COMPLEX*16 CTEMP, PLUS1, PLUS2, RA, RB, S, STAR1
166 DOUBLE PRECISION DLAMCH
175 INTRINSIC abs, dble, dcmplx, dconjg, max, sqrt
179 path( 1: 1 ) =
'Zomplex precision'
181 unfl =
dlamch(
'Safe minimum' )
184 bignum = ( one-ulp ) / smlnum
185 CALL dlabad( smlnum, bignum )
186 IF( ( imat.GE.7 .AND. imat.LE.10 ) .OR. imat.EQ.18 )
THEN
200 upper =
lsame( uplo,
'U' )
202 CALL zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
206 CALL zlatb4( path, -imat, n, n,
TYPE, KL, KU, ANORM, MODE,
214 CALL zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE, CNDNUM,
215 $ ANORM, KL, KU, PACKIT, AP, N, WORK, INFO )
222 ELSE IF( imat.EQ.7 )
THEN
249 ELSE IF( imat.LE.10 )
THEN
328 star1 = 0.25d0*
zlarnd( 5, iseed )
330 plus1 = sfac*
zlarnd( 5, iseed )
332 plus2 = star1 / plus1
338 plus1 = star1 / plus2
340 IF( rexp.LT.zero )
THEN
341 star1 = -sfac**( one-rexp )*
zlarnd( 5, iseed )
343 star1 = sfac**( one+rexp )*
zlarnd( 5, iseed )
348 x = sqrt( cndnum ) - one / sqrt( cndnum )
350 y = sqrt( two / dble( n-2 ) )*x
365 $ ap( jc+j-1 ) = work( j-2 )
367 $ ap( jc+j-2 ) = work( n+j-3 )
386 ap( jc+1 ) = work( j-1 )
388 $ ap( jc+2 ) = work( n+j-1 )
400 ra = ap( jcnext+j-1 )
402 CALL zrotg( ra, rb, c, s )
409 ctemp = c*ap( jx+j ) + s*ap( jx+j+1 )
410 ap( jx+j+1 ) = -dconjg( s )*ap( jx+j ) +
420 $
CALL zrot( j-1, ap( jcnext ), 1, ap( jc ), 1, -c, -s )
424 ap( jcnext+j-1 ) = -ap( jcnext+j-1 )
430 jcnext = jc + n - j + 1
433 CALL zrotg( ra, rb, c, s )
439 $
CALL zrot( n-j-1, ap( jcnext+1 ), 1, ap( jc+2 ), 1, c,
447 ctemp = -c*ap( jx+j-i ) + s*ap( jx+j-i+1 )
448 ap( jx+j-i+1 ) = -dconjg( s )*ap( jx+j-i ) -
457 ap( jc+1 ) = -ap( jc+1 )
466 ELSE IF( imat.EQ.11 )
THEN
475 CALL zlarnv( 4, iseed, j-1, ap( jc ) )
476 ap( jc+j-1 ) =
zlarnd( 5, iseed )*two
483 $
CALL zlarnv( 4, iseed, n-j, ap( jc+1 ) )
484 ap( jc ) =
zlarnd( 5, iseed )*two
491 CALL zlarnv( 2, iseed, n, b )
493 bnorm = abs( b( iy ) )
494 bscal = bignum / max( one, bnorm )
495 CALL zdscal( n, bscal, b, 1 )
497 ELSE IF( imat.EQ.12 )
THEN
503 CALL zlarnv( 2, iseed, n, b )
504 tscal = one / max( one, dble( n-1 ) )
508 CALL zlarnv( 4, iseed, j-1, ap( jc ) )
509 CALL zdscal( j-1, tscal, ap( jc ), 1 )
510 ap( jc+j-1 ) =
zlarnd( 5, iseed )
513 ap( n*( n+1 ) / 2 ) = smlnum*ap( n*( n+1 ) / 2 )
517 CALL zlarnv( 2, iseed, n-j, ap( jc+1 ) )
518 CALL zdscal( n-j, tscal, ap( jc+1 ), 1 )
519 ap( jc ) =
zlarnd( 5, iseed )
522 ap( 1 ) = smlnum*ap( 1 )
525 ELSE IF( imat.EQ.13 )
THEN
531 CALL zlarnv( 2, iseed, n, b )
535 CALL zlarnv( 4, iseed, j-1, ap( jc ) )
536 ap( jc+j-1 ) =
zlarnd( 5, iseed )
539 ap( n*( n+1 ) / 2 ) = smlnum*ap( n*( n+1 ) / 2 )
543 CALL zlarnv( 4, iseed, n-j, ap( jc+1 ) )
544 ap( jc ) =
zlarnd( 5, iseed )
547 ap( 1 ) = smlnum*ap( 1 )
550 ELSE IF( imat.EQ.14 )
THEN
558 jc = ( n-1 )*n / 2 + 1
563 IF( jcount.LE.2 )
THEN
564 ap( jc+j-1 ) = smlnum*
zlarnd( 5, iseed )
566 ap( jc+j-1 ) =
zlarnd( 5, iseed )
580 IF( jcount.LE.2 )
THEN
581 ap( jc ) = smlnum*
zlarnd( 5, iseed )
583 ap( jc ) =
zlarnd( 5, iseed )
598 b( i-1 ) = smlnum*
zlarnd( 5, iseed )
602 DO 290 i = 1, n - 1, 2
604 b( i+1 ) = smlnum*
zlarnd( 5, iseed )
608 ELSE IF( imat.EQ.15 )
THEN
614 texp = one / max( one, dble( n-1 ) )
616 CALL zlarnv( 4, iseed, n, b )
624 $ ap( jc+j-2 ) = dcmplx( -one, -one )
625 ap( jc+j-1 ) = tscal*
zlarnd( 5, iseed )
628 b( n ) = dcmplx( one, one )
636 $ ap( jc+1 ) = dcmplx( -one, -one )
637 ap( jc ) = tscal*
zlarnd( 5, iseed )
640 b( 1 ) = dcmplx( one, one )
643 ELSE IF( imat.EQ.16 )
THEN
651 CALL zlarnv( 4, iseed, j, ap( jc ) )
653 ap( jc+j-1 ) =
zlarnd( 5, iseed )*two
662 CALL zlarnv( 4, iseed, n-j+1, ap( jc ) )
664 ap( jc ) =
zlarnd( 5, iseed )*two
671 CALL zlarnv( 2, iseed, n, b )
672 CALL zdscal( n, two, b, 1 )
674 ELSE IF( imat.EQ.17 )
THEN
682 tscal = ( one-ulp ) / tscal
683 DO 360 j = 1, n*( n+1 ) / 2
688 jc = ( n-1 )*n / 2 + 1
690 ap( jc ) = -tscal / dble( n+1 )
692 b( j ) = texp*( one-ulp )
694 ap( jc ) = -( tscal / dble( n+1 ) ) / dble( n+2 )
696 b( j-1 ) = texp*dble( n*n+n-1 )
700 b( 1 ) = ( dble( n+1 ) / dble( n+2 ) )*tscal
703 DO 380 j = 1, n - 1, 2
704 ap( jc+n-j ) = -tscal / dble( n+1 )
706 b( j ) = texp*( one-ulp )
708 ap( jc+n-j-1 ) = -( tscal / dble( n+1 ) ) / dble( n+2 )
710 b( j+1 ) = texp*dble( n*n+n-1 )
714 b( n ) = ( dble( n+1 ) / dble( n+2 ) )*tscal
717 ELSE IF( imat.EQ.18 )
THEN
726 CALL zlarnv( 4, iseed, j-1, ap( jc ) )
734 $
CALL zlarnv( 4, iseed, n-j, ap( jc+1 ) )
742 CALL zlarnv( 2, iseed, n, b )
744 bnorm = abs( b( iy ) )
745 bscal = bignum / max( one, bnorm )
746 CALL zdscal( n, bscal, b, 1 )
748 ELSE IF( imat.EQ.19 )
THEN
755 tleft = bignum / max( one, dble( n-1 ) )
756 tscal = bignum*( dble( n-1 ) / max( one, dble( n ) ) )
760 CALL zlarnv( 5, iseed, j, ap( jc ) )
761 CALL dlarnv( 1, iseed, j, rwork )
763 ap( jc+i-1 ) = ap( jc+i-1 )*( tleft+rwork( i )*tscal )
770 CALL zlarnv( 5, iseed, n-j+1, ap( jc ) )
771 CALL dlarnv( 1, iseed, n-j+1, rwork )
773 ap( jc+i-j ) = ap( jc+i-j )*
774 $ ( tleft+rwork( i-j+1 )*tscal )
779 CALL zlarnv( 2, iseed, n, b )
780 CALL zdscal( n, two, b, 1 )
786 IF( .NOT.
lsame( trans,
'N' ) )
THEN
794 ap( jr-i+j ) = ap( jl )
808 ap( jl+i-j ) = ap( jr )
double precision function dlamch(CMACH)
DLAMCH
subroutine dlabad(SMALL, LARGE)
DLABAD
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
logical function lsame(CA, CB)
LSAME
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
complex *16 function zlarnd(IDIST, ISEED)
ZLARND
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 zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine zrotg(a, b, c, s)
ZROTG