141 SUBROUTINE zlattb( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB,
142 $ ldab, b, work, rwork, info )
150 CHARACTER DIAG, TRANS, UPLO
151 INTEGER IMAT, INFO, KD, LDAB, N
155 DOUBLE PRECISION RWORK( * )
156 COMPLEX*16 AB( ldab, * ), B( * ), WORK( * )
162 DOUBLE PRECISION ONE, TWO, ZERO
163 parameter ( one = 1.0d+0, two = 2.0d+0, zero = 0.0d+0 )
167 CHARACTER DIST, PACKIT, TYPE
169 INTEGER I, IOFF, IY, J, JCOUNT, KL, KU, LENJ, MODE
170 DOUBLE PRECISION ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, REXP,
171 $ sfac, smlnum, texp, tleft, tnorm, tscal, ulp,
173 COMPLEX*16 PLUS1, PLUS2, STAR1
178 DOUBLE PRECISION DLAMCH, DLARND
180 EXTERNAL lsame, izamax, dlamch, dlarnd, zlarnd
187 INTRINSIC abs, dble, dcmplx, max, min, sqrt
191 path( 1: 1 ) =
'Zomplex precision'
193 unfl = dlamch(
'Safe minimum' )
194 ulp = dlamch(
'Epsilon' )*dlamch(
'Base' )
196 bignum = ( one-ulp ) / smlnum
197 CALL dlabad( smlnum, bignum )
198 IF( ( imat.GE.6 .AND. imat.LE.9 ) .OR. imat.EQ.17 )
THEN
212 upper = lsame( uplo,
'U' )
214 CALL zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
217 ioff = 1 + max( 0, kd-n+1 )
221 CALL zlatb4( path, -imat, n, n,
TYPE, KL, KU, ANORM, MODE,
232 CALL zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE, CNDNUM,
233 $ anorm, kl, ku, packit, ab( ioff, 1 ), ldab, work,
241 ELSE IF( imat.EQ.6 )
THEN
244 DO 10 i = max( 1, kd+2-j ), kd
252 DO 30 i = 2, min( kd+1, n-j+1 )
263 ELSE IF( imat.LE.9 )
THEN
264 tnorm = sqrt( cndnum )
270 DO 50 i = max( 1, kd+2-j ), kd
273 ab( kd+1, j ) = dble( j )
277 DO 70 i = 2, min( kd+1, n-j+1 )
280 ab( 1, j ) = dble( j )
289 ab( 1, 2 ) = tnorm*zlarnd( 5, iseed )
291 CALL zlarnv( 2, iseed, lenj, work )
293 ab( 1, 2*( j+1 ) ) = tnorm*work( j )
296 ab( 2, 1 ) = tnorm*zlarnd( 5, iseed )
298 CALL zlarnv( 2, iseed, lenj, work )
300 ab( 2, 2*j+1 ) = tnorm*work( j )
303 ELSE IF( kd.GT.1 )
THEN
321 star1 = tnorm*zlarnd( 5, iseed )
323 plus1 = sfac*zlarnd( 5, iseed )
325 plus2 = star1 / plus1
331 plus1 = star1 / plus2
336 rexp = dlarnd( 2, iseed )
337 IF( rexp.LT.zero )
THEN
338 star1 = -sfac**( one-rexp )*zlarnd( 5, iseed )
340 star1 = sfac**( one+rexp )*zlarnd( 5, iseed )
348 CALL zcopy( n-1, work, 1, ab( kd, 2 ), ldab )
349 CALL zcopy( n-2, work( n+1 ), 1, ab( kd-1, 3 ), ldab )
351 CALL zcopy( n-1, work, 1, ab( 2, 1 ), ldab )
352 CALL zcopy( n-2, work( n+1 ), 1, ab( 3, 1 ), ldab )
360 ELSE IF( imat.EQ.10 )
THEN
368 lenj = min( j-1, kd )
369 CALL zlarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
370 ab( kd+1, j ) = zlarnd( 5, iseed )*two
374 lenj = min( n-j, kd )
376 $
CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
377 ab( 1, j ) = zlarnd( 5, iseed )*two
383 CALL zlarnv( 2, iseed, n, b )
384 iy = izamax( n, b, 1 )
385 bnorm = abs( b( iy ) )
386 bscal = bignum / max( one, bnorm )
387 CALL zdscal( n, bscal, b, 1 )
389 ELSE IF( imat.EQ.11 )
THEN
395 CALL zlarnv( 2, iseed, n, b )
396 tscal = one / dble( kd+1 )
399 lenj = min( j-1, kd )
401 CALL zlarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
402 CALL zdscal( lenj, tscal, ab( kd+2-lenj, j ), 1 )
404 ab( kd+1, j ) = zlarnd( 5, iseed )
406 ab( kd+1, n ) = smlnum*ab( kd+1, n )
409 lenj = min( n-j, kd )
411 CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
412 CALL zdscal( lenj, tscal, ab( 2, j ), 1 )
414 ab( 1, j ) = zlarnd( 5, iseed )
416 ab( 1, 1 ) = smlnum*ab( 1, 1 )
419 ELSE IF( imat.EQ.12 )
THEN
425 CALL zlarnv( 2, iseed, n, b )
428 lenj = min( j-1, kd )
430 $
CALL zlarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
431 ab( kd+1, j ) = zlarnd( 5, iseed )
433 ab( kd+1, n ) = smlnum*ab( kd+1, n )
436 lenj = min( n-j, kd )
438 $
CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
439 ab( 1, j ) = zlarnd( 5, iseed )
441 ab( 1, 1 ) = smlnum*ab( 1, 1 )
444 ELSE IF( imat.EQ.13 )
THEN
453 DO 180 i = max( 1, kd+1-( j-1 ) ), kd
456 IF( jcount.LE.2 )
THEN
457 ab( kd+1, j ) = smlnum*zlarnd( 5, iseed )
459 ab( kd+1, j ) = zlarnd( 5, iseed )
468 DO 200 i = 2, min( n-j+1, kd+1 )
471 IF( jcount.LE.2 )
THEN
472 ab( 1, j ) = smlnum*zlarnd( 5, iseed )
474 ab( 1, j ) = zlarnd( 5, iseed )
488 b( i-1 ) = smlnum*zlarnd( 5, iseed )
492 DO 230 i = 1, n - 1, 2
494 b( i+1 ) = smlnum*zlarnd( 5, iseed )
498 ELSE IF( imat.EQ.14 )
THEN
504 texp = one / dble( kd+1 )
506 CALL zlarnv( 4, iseed, n, b )
509 DO 240 i = max( 1, kd+2-j ), kd
512 IF( j.GT.1 .AND. kd.GT.0 )
513 $ ab( kd, j ) = dcmplx( -one, -one )
514 ab( kd+1, j ) = tscal*zlarnd( 5, iseed )
516 b( n ) = dcmplx( one, one )
519 DO 260 i = 3, min( n-j+1, kd+1 )
522 IF( j.LT.n .AND. kd.GT.0 )
523 $ ab( 2, j ) = dcmplx( -one, -one )
524 ab( 1, j ) = tscal*zlarnd( 5, iseed )
526 b( 1 ) = dcmplx( one, one )
529 ELSE IF( imat.EQ.15 )
THEN
536 lenj = min( j, kd+1 )
537 CALL zlarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
539 ab( kd+1, j ) = zlarnd( 5, iseed )*two
546 lenj = min( n-j+1, kd+1 )
547 CALL zlarnv( 4, iseed, lenj, ab( 1, j ) )
549 ab( 1, j ) = zlarnd( 5, iseed )*two
555 CALL zlarnv( 2, iseed, n, b )
556 CALL zdscal( n, two, b, 1 )
558 ELSE IF( imat.EQ.16 )
THEN
566 tscal = ( one-ulp ) / tscal
576 DO 320 i = j, max( 1, j-kd+1 ), -2
577 ab( 1+( j-i ), i ) = -tscal / dble( kd+2 )
579 b( i ) = texp*( one-ulp )
580 IF( i.GT.max( 1, j-kd+1 ) )
THEN
581 ab( 2+( j-i ), i-1 ) = -( tscal / dble( kd+2 ) )
583 ab( kd+1, i-1 ) = one
584 b( i-1 ) = texp*dble( ( kd+1 )*( kd+1 )+kd )
588 b( max( 1, j-kd+1 ) ) = ( dble( kd+2 ) /
589 $ dble( kd+3 ) )*tscal
594 lenj = min( kd+1, n-j+1 )
595 DO 340 i = j, min( n, j+kd-1 ), 2
596 ab( lenj-( i-j ), j ) = -tscal / dble( kd+2 )
598 b( j ) = texp*( one-ulp )
599 IF( i.LT.min( n, j+kd-1 ) )
THEN
600 ab( lenj-( i-j+1 ), i+1 ) = -( tscal /
601 $ dble( kd+2 ) ) / dble( kd+3 )
603 b( i+1 ) = texp*dble( ( kd+1 )*( kd+1 )+kd )
607 b( min( n, j+kd-1 ) ) = ( dble( kd+2 ) /
608 $ dble( kd+3 ) )*tscal
613 ELSE IF( imat.EQ.17 )
THEN
621 lenj = min( j-1, kd )
622 CALL zlarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
623 ab( kd+1, j ) = dble( j )
627 lenj = min( n-j, kd )
629 $
CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
630 ab( 1, j ) = dble( j )
636 CALL zlarnv( 2, iseed, n, b )
637 iy = izamax( n, b, 1 )
638 bnorm = abs( b( iy ) )
639 bscal = bignum / max( one, bnorm )
640 CALL zdscal( n, bscal, b, 1 )
642 ELSE IF( imat.EQ.18 )
THEN
649 tleft = bignum / dble( kd+1 )
650 tscal = bignum*( dble( kd+1 ) / dble( kd+2 ) )
653 lenj = min( j, kd+1 )
654 CALL zlarnv( 5, iseed, lenj, ab( kd+2-lenj, j ) )
655 CALL dlarnv( 1, iseed, lenj, rwork( kd+2-lenj ) )
656 DO 380 i = kd + 2 - lenj, kd + 1
657 ab( i, j ) = ab( i, j )*( tleft+rwork( i )*tscal )
662 lenj = min( n-j+1, kd+1 )
663 CALL zlarnv( 5, iseed, lenj, ab( 1, j ) )
664 CALL dlarnv( 1, iseed, lenj, rwork )
666 ab( i, j ) = ab( i, j )*( tleft+rwork( i )*tscal )
670 CALL zlarnv( 2, iseed, n, b )
671 CALL zdscal( n, two, b, 1 )
676 IF( .NOT.lsame( trans,
'N' ) )
THEN
679 lenj = min( n-2*j+1, kd+1 )
680 CALL zswap( lenj, ab( kd+1, j ), ldab-1,
681 $ ab( kd+2-lenj, n-j+1 ), -1 )
685 lenj = min( n-2*j+1, kd+1 )
686 CALL zswap( lenj, ab( 1, j ), 1, ab( lenj, n-j+2-lenj ),
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
subroutine zlattb(IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, LDAB, B, WORK, RWORK, INFO)
ZLATTB
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 dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.