139 SUBROUTINE clattb( 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
153 COMPLEX AB( LDAB, * ), B( * ), WORK( * )
160 parameter( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+0 )
164 CHARACTER DIST, PACKIT, TYPE
166 INTEGER I, IOFF, IY, J, JCOUNT, KL, KU, LENJ, MODE
167 REAL ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, REXP,
168 $ sfac, smlnum, texp, tleft, tnorm, tscal, ulp,
170 COMPLEX PLUS1, PLUS2, STAR1
177 EXTERNAL lsame, icamax, slamch, slarnd, clarnd
184 INTRINSIC abs, cmplx, max, min, real, sqrt
188 path( 1: 1 ) =
'Complex precision'
190 unfl = slamch(
'Safe minimum' )
191 ulp = slamch(
'Epsilon' )*slamch(
'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 clatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
213 ioff = 1 + max( 0, kd-n+1 )
217 CALL clatb4( path, -imat, n, n,
TYPE, kl, ku, anorm, mode,
228 CALL clatms( 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 ) = real( j )
273 DO 70 i = 2, min( kd+1, n-j+1 )
276 ab( 1, j ) = real( j )
285 ab( 1, 2 ) = tnorm*clarnd( 5, iseed )
287 CALL clarnv( 2, iseed, lenj, work )
289 ab( 1, 2*( j+1 ) ) = tnorm*work( j )
292 ab( 2, 1 ) = tnorm*clarnd( 5, iseed )
294 CALL clarnv( 2, iseed, lenj, work )
296 ab( 2, 2*j+1 ) = tnorm*work( j )
299 ELSE IF( kd.GT.1 )
THEN
317 star1 = tnorm*clarnd( 5, iseed )
319 plus1 = sfac*clarnd( 5, iseed )
321 plus2 = star1 / plus1
327 plus1 = star1 / plus2
332 rexp = slarnd( 2, iseed )
333 IF( rexp.LT.zero )
THEN
334 star1 = -sfac**( one-rexp )*clarnd( 5, iseed )
336 star1 = sfac**( one+rexp )*clarnd( 5, iseed )
344 CALL ccopy( n-1, work, 1, ab( kd, 2 ), ldab )
345 CALL ccopy( n-2, work( n+1 ), 1, ab( kd-1, 3 ), ldab )
347 CALL ccopy( n-1, work, 1, ab( 2, 1 ), ldab )
348 CALL ccopy( 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 clarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
366 ab( kd+1, j ) = clarnd( 5, iseed )*two
370 lenj = min( n-j, kd )
372 $
CALL clarnv( 4, iseed, lenj, ab( 2, j ) )
373 ab( 1, j ) = clarnd( 5, iseed )*two
379 CALL clarnv( 2, iseed, n, b )
380 iy = icamax( n, b, 1 )
381 bnorm = abs( b( iy ) )
382 bscal = bignum / max( one, bnorm )
383 CALL csscal( n, bscal, b, 1 )
385 ELSE IF( imat.EQ.11 )
THEN
391 CALL clarnv( 2, iseed, n, b )
392 tscal = one / real( kd+1 )
395 lenj = min( j-1, kd )
397 CALL clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
398 CALL csscal( lenj, tscal, ab( kd+2-lenj, j ), 1 )
400 ab( kd+1, j ) = clarnd( 5, iseed )
402 ab( kd+1, n ) = smlnum*ab( kd+1, n )
405 lenj = min( n-j, kd )
407 CALL clarnv( 4, iseed, lenj, ab( 2, j ) )
408 CALL csscal( lenj, tscal, ab( 2, j ), 1 )
410 ab( 1, j ) = clarnd( 5, iseed )
412 ab( 1, 1 ) = smlnum*ab( 1, 1 )
415 ELSE IF( imat.EQ.12 )
THEN
421 CALL clarnv( 2, iseed, n, b )
424 lenj = min( j-1, kd )
426 $
CALL clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
427 ab( kd+1, j ) = clarnd( 5, iseed )
429 ab( kd+1, n ) = smlnum*ab( kd+1, n )
432 lenj = min( n-j, kd )
434 $
CALL clarnv( 4, iseed, lenj, ab( 2, j ) )
435 ab( 1, j ) = clarnd( 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*clarnd( 5, iseed )
455 ab( kd+1, j ) = clarnd( 5, iseed )
464 DO 200 i = 2, min( n-j+1, kd+1 )
467 IF( jcount.LE.2 )
THEN
468 ab( 1, j ) = smlnum*clarnd( 5, iseed )
470 ab( 1, j ) = clarnd( 5, iseed )
484 b( i-1 ) = smlnum*clarnd( 5, iseed )
488 DO 230 i = 1, n - 1, 2
490 b( i+1 ) = smlnum*clarnd( 5, iseed )
494 ELSE IF( imat.EQ.14 )
THEN
500 texp = one / real( kd+1 )
502 CALL clarnv( 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 ) = cmplx( -one, -one )
510 ab( kd+1, j ) = tscal*clarnd( 5, iseed )
512 b( n ) = cmplx( 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 ) = cmplx( -one, -one )
520 ab( 1, j ) = tscal*clarnd( 5, iseed )
522 b( 1 ) = cmplx( one, one )
525 ELSE IF( imat.EQ.15 )
THEN
532 lenj = min( j, kd+1 )
533 CALL clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
535 ab( kd+1, j ) = clarnd( 5, iseed )*two
542 lenj = min( n-j+1, kd+1 )
543 CALL clarnv( 4, iseed, lenj, ab( 1, j ) )
545 ab( 1, j ) = clarnd( 5, iseed )*two
551 CALL clarnv( 2, iseed, n, b )
552 CALL csscal( 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 / real( 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 / real( kd+2 ) )
579 ab( kd+1, i-1 ) = one
580 b( i-1 ) = texp*real( ( kd+1 )*( kd+1 )+kd )
584 b( max( 1, j-kd+1 ) ) = ( real( kd+2 ) /
585 $ real( 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 / real( 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 $ real( kd+2 ) ) / real( kd+3 )
599 b( i+1 ) = texp*real( ( kd+1 )*( kd+1 )+kd )
603 b( min( n, j+kd-1 ) ) = ( real( kd+2 ) /
604 $ real( kd+3 ) )*tscal
609 ELSE IF( imat.EQ.17 )
THEN
617 lenj = min( j-1, kd )
618 CALL clarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
619 ab( kd+1, j ) = real( j )
623 lenj = min( n-j, kd )
625 $
CALL clarnv( 4, iseed, lenj, ab( 2, j ) )
626 ab( 1, j ) = real( j )
632 CALL clarnv( 2, iseed, n, b )
633 iy = icamax( n, b, 1 )
634 bnorm = abs( b( iy ) )
635 bscal = bignum / max( one, bnorm )
636 CALL csscal( n, bscal, b, 1 )
638 ELSE IF( imat.EQ.18 )
THEN
645 tleft = bignum / real( kd+1 )
646 tscal = bignum*( real( kd+1 ) / real( kd+2 ) )
649 lenj = min( j, kd+1 )
650 CALL clarnv( 5, iseed, lenj, ab( kd+2-lenj, j ) )
651 CALL slarnv( 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 clarnv( 5, iseed, lenj, ab( 1, j ) )
660 CALL slarnv( 1, iseed, lenj, rwork )
662 ab( i, j ) = ab( i, j )*( tleft+rwork( i )*tscal )
666 CALL clarnv( 2, iseed, n, b )
667 CALL csscal( n, two, b, 1 )
672 IF( .NOT.lsame( trans,
'N' ) )
THEN
675 lenj = min( n-2*j+1, kd+1 )
676 CALL cswap( 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 cswap( lenj, ab( 1, j ), 1, ab( lenj, n-j+2-lenj ),
subroutine clatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
CLATB4
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
subroutine clattb(imat, uplo, trans, diag, iseed, n, kd, ab, ldab, b, work, rwork, info)
CLATTB
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
subroutine slarnv(idist, iseed, n, x)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine clarnv(idist, iseed, n, x)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine csscal(n, sa, cx, incx)
CSSCAL
subroutine cswap(n, cx, incx, cy, incy)
CSWAP