147 CHARACTER DIAG, TRANS, UPLO
148 INTEGER IMAT, INFO, KD, LDAB, N
152 DOUBLE PRECISION RWORK( * )
153 COMPLEX*16 AB( LDAB, * ), B( * ), WORK( * )
159 DOUBLE PRECISION ONE, TWO, ZERO
160 parameter( one = 1.0d+0, two = 2.0d+0, zero = 0.0d+0 )
164 CHARACTER DIST, PACKIT, TYPE
166 INTEGER I, IOFF, IY, J, JCOUNT, KL, KU, LENJ, MODE
167 DOUBLE PRECISION ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, REXP,
168 $ SFAC, SMLNUM, TEXP, TLEFT, TNORM, TSCAL, ULP,
170 COMPLEX*16 PLUS1, PLUS2, STAR1
175 DOUBLE PRECISION DLAMCH, DLARND
184 INTRINSIC abs, dble, dcmplx, max, min, sqrt
188 path( 1: 1 ) =
'Zomplex precision'
190 unfl =
dlamch(
'Safe minimum' )
193 bignum = ( one-ulp ) / smlnum
194 CALL dlabad( smlnum, bignum )
195 IF( ( imat.GE.6 .AND. imat.LE.9 ) .OR. imat.EQ.17 )
THEN
209 upper =
lsame( uplo,
'U' )
211 CALL zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
214 ioff = 1 + max( 0, kd-n+1 )
218 CALL zlatb4( path, -imat, n, n,
TYPE, KL, KU, ANORM, MODE,
229 CALL zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE, CNDNUM,
230 $ ANORM, KL, KU, PACKIT, AB( IOFF, 1 ), LDAB, WORK,
238 ELSE IF( imat.EQ.6 )
THEN
241 DO 10 i = max( 1, kd+2-j ), kd
249 DO 30 i = 2, min( kd+1, n-j+1 )
260 ELSE IF( imat.LE.9 )
THEN
261 tnorm = sqrt( cndnum )
267 DO 50 i = max( 1, kd+2-j ), kd
270 ab( kd+1, j ) = dble( j )
274 DO 70 i = 2, min( kd+1, n-j+1 )
277 ab( 1, j ) = dble( j )
286 ab( 1, 2 ) = tnorm*
zlarnd( 5, iseed )
288 CALL zlarnv( 2, iseed, lenj, work )
290 ab( 1, 2*( j+1 ) ) = tnorm*work( j )
293 ab( 2, 1 ) = tnorm*
zlarnd( 5, iseed )
295 CALL zlarnv( 2, iseed, lenj, work )
297 ab( 2, 2*j+1 ) = tnorm*work( j )
300 ELSE IF( kd.GT.1 )
THEN
318 star1 = tnorm*
zlarnd( 5, iseed )
320 plus1 = sfac*
zlarnd( 5, iseed )
322 plus2 = star1 / plus1
328 plus1 = star1 / plus2
334 IF( rexp.LT.zero )
THEN
335 star1 = -sfac**( one-rexp )*
zlarnd( 5, iseed )
337 star1 = sfac**( one+rexp )*
zlarnd( 5, iseed )
345 CALL zcopy( n-1, work, 1, ab( kd, 2 ), ldab )
346 CALL zcopy( n-2, work( n+1 ), 1, ab( kd-1, 3 ), ldab )
348 CALL zcopy( n-1, work, 1, ab( 2, 1 ), ldab )
349 CALL zcopy( n-2, work( n+1 ), 1, ab( 3, 1 ), ldab )
357 ELSE IF( imat.EQ.10 )
THEN
365 lenj = min( j-1, kd )
366 CALL zlarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
367 ab( kd+1, j ) =
zlarnd( 5, iseed )*two
371 lenj = min( n-j, kd )
373 $
CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
374 ab( 1, j ) =
zlarnd( 5, iseed )*two
380 CALL zlarnv( 2, iseed, n, b )
382 bnorm = abs( b( iy ) )
383 bscal = bignum / max( one, bnorm )
384 CALL zdscal( n, bscal, b, 1 )
386 ELSE IF( imat.EQ.11 )
THEN
392 CALL zlarnv( 2, iseed, n, b )
393 tscal = one / dble( kd+1 )
396 lenj = min( j-1, kd )
398 CALL zlarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
399 CALL zdscal( lenj, tscal, ab( kd+2-lenj, j ), 1 )
401 ab( kd+1, j ) =
zlarnd( 5, iseed )
403 ab( kd+1, n ) = smlnum*ab( kd+1, n )
406 lenj = min( n-j, kd )
408 CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
409 CALL zdscal( lenj, tscal, ab( 2, j ), 1 )
411 ab( 1, j ) =
zlarnd( 5, iseed )
413 ab( 1, 1 ) = smlnum*ab( 1, 1 )
416 ELSE IF( imat.EQ.12 )
THEN
422 CALL zlarnv( 2, iseed, n, b )
425 lenj = min( j-1, kd )
427 $
CALL zlarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
428 ab( kd+1, j ) =
zlarnd( 5, iseed )
430 ab( kd+1, n ) = smlnum*ab( kd+1, n )
433 lenj = min( n-j, kd )
435 $
CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
436 ab( 1, j ) =
zlarnd( 5, iseed )
438 ab( 1, 1 ) = smlnum*ab( 1, 1 )
441 ELSE IF( imat.EQ.13 )
THEN
450 DO 180 i = max( 1, kd+1-( j-1 ) ), kd
453 IF( jcount.LE.2 )
THEN
454 ab( kd+1, j ) = smlnum*
zlarnd( 5, iseed )
456 ab( kd+1, j ) =
zlarnd( 5, iseed )
465 DO 200 i = 2, min( n-j+1, kd+1 )
468 IF( jcount.LE.2 )
THEN
469 ab( 1, j ) = smlnum*
zlarnd( 5, iseed )
471 ab( 1, j ) =
zlarnd( 5, iseed )
485 b( i-1 ) = smlnum*
zlarnd( 5, iseed )
489 DO 230 i = 1, n - 1, 2
491 b( i+1 ) = smlnum*
zlarnd( 5, iseed )
495 ELSE IF( imat.EQ.14 )
THEN
501 texp = one / dble( kd+1 )
503 CALL zlarnv( 4, iseed, n, b )
506 DO 240 i = max( 1, kd+2-j ), kd
509 IF( j.GT.1 .AND. kd.GT.0 )
510 $ ab( kd, j ) = dcmplx( -one, -one )
511 ab( kd+1, j ) = tscal*
zlarnd( 5, iseed )
513 b( n ) = dcmplx( one, one )
516 DO 260 i = 3, min( n-j+1, kd+1 )
519 IF( j.LT.n .AND. kd.GT.0 )
520 $ ab( 2, j ) = dcmplx( -one, -one )
521 ab( 1, j ) = tscal*
zlarnd( 5, iseed )
523 b( 1 ) = dcmplx( one, one )
526 ELSE IF( imat.EQ.15 )
THEN
533 lenj = min( j, kd+1 )
534 CALL zlarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
536 ab( kd+1, j ) =
zlarnd( 5, iseed )*two
543 lenj = min( n-j+1, kd+1 )
544 CALL zlarnv( 4, iseed, lenj, ab( 1, j ) )
546 ab( 1, j ) =
zlarnd( 5, iseed )*two
552 CALL zlarnv( 2, iseed, n, b )
553 CALL zdscal( n, two, b, 1 )
555 ELSE IF( imat.EQ.16 )
THEN
563 tscal = ( one-ulp ) / tscal
573 DO 320 i = j, max( 1, j-kd+1 ), -2
574 ab( 1+( j-i ), i ) = -tscal / dble( kd+2 )
576 b( i ) = texp*( one-ulp )
577 IF( i.GT.max( 1, j-kd+1 ) )
THEN
578 ab( 2+( j-i ), i-1 ) = -( tscal / dble( kd+2 ) )
580 ab( kd+1, i-1 ) = one
581 b( i-1 ) = texp*dble( ( kd+1 )*( kd+1 )+kd )
585 b( max( 1, j-kd+1 ) ) = ( dble( kd+2 ) /
586 $ dble( kd+3 ) )*tscal
591 lenj = min( kd+1, n-j+1 )
592 DO 340 i = j, min( n, j+kd-1 ), 2
593 ab( lenj-( i-j ), j ) = -tscal / dble( kd+2 )
595 b( j ) = texp*( one-ulp )
596 IF( i.LT.min( n, j+kd-1 ) )
THEN
597 ab( lenj-( i-j+1 ), i+1 ) = -( tscal /
598 $ dble( kd+2 ) ) / dble( kd+3 )
600 b( i+1 ) = texp*dble( ( kd+1 )*( kd+1 )+kd )
604 b( min( n, j+kd-1 ) ) = ( dble( kd+2 ) /
605 $ dble( kd+3 ) )*tscal
610 ELSE IF( imat.EQ.17 )
THEN
618 lenj = min( j-1, kd )
619 CALL zlarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
620 ab( kd+1, j ) = dble( j )
624 lenj = min( n-j, kd )
626 $
CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
627 ab( 1, j ) = dble( j )
633 CALL zlarnv( 2, iseed, n, b )
635 bnorm = abs( b( iy ) )
636 bscal = bignum / max( one, bnorm )
637 CALL zdscal( n, bscal, b, 1 )
639 ELSE IF( imat.EQ.18 )
THEN
646 tleft = bignum / dble( kd+1 )
647 tscal = bignum*( dble( kd+1 ) / dble( kd+2 ) )
650 lenj = min( j, kd+1 )
651 CALL zlarnv( 5, iseed, lenj, ab( kd+2-lenj, j ) )
652 CALL dlarnv( 1, iseed, lenj, rwork( kd+2-lenj ) )
653 DO 380 i = kd + 2 - lenj, kd + 1
654 ab( i, j ) = ab( i, j )*( tleft+rwork( i )*tscal )
659 lenj = min( n-j+1, kd+1 )
660 CALL zlarnv( 5, iseed, lenj, ab( 1, j ) )
661 CALL dlarnv( 1, iseed, lenj, rwork )
663 ab( i, j ) = ab( i, j )*( tleft+rwork( i )*tscal )
667 CALL zlarnv( 2, iseed, n, b )
668 CALL zdscal( n, two, b, 1 )
673 IF( .NOT.
lsame( trans,
'N' ) )
THEN
676 lenj = min( n-2*j+1, kd+1 )
677 CALL zswap( lenj, ab( kd+1, j ), ldab-1,
678 $ ab( kd+2-lenj, n-j+1 ), -1 )
682 lenj = min( n-2*j+1, kd+1 )
683 CALL zswap( lenj, ab( 1, j ), 1, ab( lenj, n-j+2-lenj ),
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 zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
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 zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
double precision function dlarnd(IDIST, ISEED)
DLARND