139 SUBROUTINE zlattb( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB,
140 $ LDAB, B, WORK, RWORK, INFO )
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
177 EXTERNAL lsame, izamax, dlamch, dlarnd, zlarnd
184 INTRINSIC abs, dble, dcmplx, max, min, sqrt
188 path( 1: 1 ) =
'Zomplex precision'
190 unfl = dlamch(
'Safe minimum' )
191 ulp = dlamch(
'Epsilon' )*dlamch(
'Base' )
193 bignum = ( one-ulp ) / smlnum
194 IF( ( imat.GE.6 .AND. imat.LE.9 ) .OR. imat.EQ.17 )
THEN
208 upper = lsame( uplo,
'U' )
210 CALL zlatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
213 ioff = 1 + max( 0, kd-n+1 )
217 CALL zlatb4( path, -imat, n, n,
TYPE, kl, ku, anorm, mode,
228 CALL zlatms( n, n, dist, iseed,
TYPE, rwork, mode, cndnum,
229 $ anorm, kl, ku, packit, ab( ioff, 1 ), ldab, work,
237 ELSE IF( imat.EQ.6 )
THEN
240 DO 10 i = max( 1, kd+2-j ), kd
248 DO 30 i = 2, min( kd+1, n-j+1 )
259 ELSE IF( imat.LE.9 )
THEN
260 tnorm = sqrt( cndnum )
266 DO 50 i = max( 1, kd+2-j ), kd
269 ab( kd+1, j ) = dble( j )
273 DO 70 i = 2, min( kd+1, n-j+1 )
276 ab( 1, j ) = dble( j )
285 ab( 1, 2 ) = tnorm*zlarnd( 5, iseed )
287 CALL zlarnv( 2, iseed, lenj, work )
289 ab( 1, 2*( j+1 ) ) = tnorm*work( j )
292 ab( 2, 1 ) = tnorm*zlarnd( 5, iseed )
294 CALL zlarnv( 2, iseed, lenj, work )
296 ab( 2, 2*j+1 ) = tnorm*work( j )
299 ELSE IF( kd.GT.1 )
THEN
317 star1 = tnorm*zlarnd( 5, iseed )
319 plus1 = sfac*zlarnd( 5, iseed )
321 plus2 = star1 / plus1
327 plus1 = star1 / plus2
332 rexp = dlarnd( 2, iseed )
333 IF( rexp.LT.zero )
THEN
334 star1 = -sfac**( one-rexp )*zlarnd( 5, iseed )
336 star1 = sfac**( one+rexp )*zlarnd( 5, iseed )
344 CALL zcopy( n-1, work, 1, ab( kd, 2 ), ldab )
345 CALL zcopy( n-2, work( n+1 ), 1, ab( kd-1, 3 ), ldab )
347 CALL zcopy( n-1, work, 1, ab( 2, 1 ), ldab )
348 CALL zcopy( n-2, work( n+1 ), 1, ab( 3, 1 ), ldab )
356 ELSE IF( imat.EQ.10 )
THEN
364 lenj = min( j-1, kd )
365 CALL zlarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
366 ab( kd+1, j ) = zlarnd( 5, iseed )*two
370 lenj = min( n-j, kd )
372 $
CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
373 ab( 1, j ) = zlarnd( 5, iseed )*two
379 CALL zlarnv( 2, iseed, n, b )
380 iy = izamax( n, b, 1 )
381 bnorm = abs( b( iy ) )
382 bscal = bignum / max( one, bnorm )
383 CALL zdscal( n, bscal, b, 1 )
385 ELSE IF( imat.EQ.11 )
THEN
391 CALL zlarnv( 2, iseed, n, b )
392 tscal = one / dble( kd+1 )
395 lenj = min( j-1, kd )
397 CALL zlarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
398 CALL zdscal( lenj, tscal, ab( kd+2-lenj, j ), 1 )
400 ab( kd+1, j ) = zlarnd( 5, iseed )
402 ab( kd+1, n ) = smlnum*ab( kd+1, n )
405 lenj = min( n-j, kd )
407 CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
408 CALL zdscal( lenj, tscal, ab( 2, j ), 1 )
410 ab( 1, j ) = zlarnd( 5, iseed )
412 ab( 1, 1 ) = smlnum*ab( 1, 1 )
415 ELSE IF( imat.EQ.12 )
THEN
421 CALL zlarnv( 2, iseed, n, b )
424 lenj = min( j-1, kd )
426 $
CALL zlarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
427 ab( kd+1, j ) = zlarnd( 5, iseed )
429 ab( kd+1, n ) = smlnum*ab( kd+1, n )
432 lenj = min( n-j, kd )
434 $
CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
435 ab( 1, j ) = zlarnd( 5, iseed )
437 ab( 1, 1 ) = smlnum*ab( 1, 1 )
440 ELSE IF( imat.EQ.13 )
THEN
449 DO 180 i = max( 1, kd+1-( j-1 ) ), kd
452 IF( jcount.LE.2 )
THEN
453 ab( kd+1, j ) = smlnum*zlarnd( 5, iseed )
455 ab( kd+1, j ) = zlarnd( 5, iseed )
464 DO 200 i = 2, min( n-j+1, kd+1 )
467 IF( jcount.LE.2 )
THEN
468 ab( 1, j ) = smlnum*zlarnd( 5, iseed )
470 ab( 1, j ) = zlarnd( 5, iseed )
484 b( i-1 ) = smlnum*zlarnd( 5, iseed )
488 DO 230 i = 1, n - 1, 2
490 b( i+1 ) = smlnum*zlarnd( 5, iseed )
494 ELSE IF( imat.EQ.14 )
THEN
500 texp = one / dble( kd+1 )
502 CALL zlarnv( 4, iseed, n, b )
505 DO 240 i = max( 1, kd+2-j ), kd
508 IF( j.GT.1 .AND. kd.GT.0 )
509 $ ab( kd, j ) = dcmplx( -one, -one )
510 ab( kd+1, j ) = tscal*zlarnd( 5, iseed )
512 b( n ) = dcmplx( one, one )
515 DO 260 i = 3, min( n-j+1, kd+1 )
518 IF( j.LT.n .AND. kd.GT.0 )
519 $ ab( 2, j ) = dcmplx( -one, -one )
520 ab( 1, j ) = tscal*zlarnd( 5, iseed )
522 b( 1 ) = dcmplx( one, one )
525 ELSE IF( imat.EQ.15 )
THEN
532 lenj = min( j, kd+1 )
533 CALL zlarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
535 ab( kd+1, j ) = zlarnd( 5, iseed )*two
542 lenj = min( n-j+1, kd+1 )
543 CALL zlarnv( 4, iseed, lenj, ab( 1, j ) )
545 ab( 1, j ) = zlarnd( 5, iseed )*two
551 CALL zlarnv( 2, iseed, n, b )
552 CALL zdscal( n, two, b, 1 )
554 ELSE IF( imat.EQ.16 )
THEN
562 tscal = ( one-ulp ) / tscal
572 DO 320 i = j, max( 1, j-kd+1 ), -2
573 ab( 1+( j-i ), i ) = -tscal / dble( kd+2 )
575 b( i ) = texp*( one-ulp )
576 IF( i.GT.max( 1, j-kd+1 ) )
THEN
577 ab( 2+( j-i ), i-1 ) = -( tscal / dble( kd+2 ) )
579 ab( kd+1, i-1 ) = one
580 b( i-1 ) = texp*dble( ( kd+1 )*( kd+1 )+kd )
584 b( max( 1, j-kd+1 ) ) = ( dble( kd+2 ) /
585 $ dble( kd+3 ) )*tscal
590 lenj = min( kd+1, n-j+1 )
591 DO 340 i = j, min( n, j+kd-1 ), 2
592 ab( lenj-( i-j ), j ) = -tscal / dble( kd+2 )
594 b( j ) = texp*( one-ulp )
595 IF( i.LT.min( n, j+kd-1 ) )
THEN
596 ab( lenj-( i-j+1 ), i+1 ) = -( tscal /
597 $ dble( kd+2 ) ) / dble( kd+3 )
599 b( i+1 ) = texp*dble( ( kd+1 )*( kd+1 )+kd )
603 b( min( n, j+kd-1 ) ) = ( dble( kd+2 ) /
604 $ dble( kd+3 ) )*tscal
609 ELSE IF( imat.EQ.17 )
THEN
617 lenj = min( j-1, kd )
618 CALL zlarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
619 ab( kd+1, j ) = dble( j )
623 lenj = min( n-j, kd )
625 $
CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
626 ab( 1, j ) = dble( j )
632 CALL zlarnv( 2, iseed, n, b )
633 iy = izamax( n, b, 1 )
634 bnorm = abs( b( iy ) )
635 bscal = bignum / max( one, bnorm )
636 CALL zdscal( n, bscal, b, 1 )
638 ELSE IF( imat.EQ.18 )
THEN
645 tleft = bignum / dble( kd+1 )
646 tscal = bignum*( dble( kd+1 ) / dble( kd+2 ) )
649 lenj = min( j, kd+1 )
650 CALL zlarnv( 5, iseed, lenj, ab( kd+2-lenj, j ) )
651 CALL dlarnv( 1, iseed, lenj, rwork( kd+2-lenj ) )
652 DO 380 i = kd + 2 - lenj, kd + 1
653 ab( i, j ) = ab( i, j )*( tleft+rwork( i )*tscal )
658 lenj = min( n-j+1, kd+1 )
659 CALL zlarnv( 5, iseed, lenj, ab( 1, j ) )
660 CALL dlarnv( 1, iseed, lenj, rwork )
662 ab( i, j ) = ab( i, j )*( tleft+rwork( i )*tscal )
666 CALL zlarnv( 2, iseed, n, b )
667 CALL zdscal( n, two, b, 1 )
672 IF( .NOT.lsame( trans,
'N' ) )
THEN
675 lenj = min( n-2*j+1, kd+1 )
676 CALL zswap( lenj, ab( kd+1, j ), ldab-1,
677 $ ab( kd+2-lenj, n-j+1 ), -1 )
681 lenj = min( n-2*j+1, kd+1 )
682 CALL zswap( lenj, ab( 1, j ), 1, ab( lenj, n-j+2-lenj ),
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 dlarnv(idist, iseed, n, x)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine zdscal(n, da, zx, incx)
ZDSCAL
subroutine zswap(n, zx, incx, zy, incy)
ZSWAP
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
subroutine zlattb(imat, uplo, trans, diag, iseed, n, kd, ab, ldab, b, work, rwork, info)
ZLATTB