141 SUBROUTINE clattb( 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
156 COMPLEX AB( ldab, * ), B( * ), WORK( * )
163 parameter ( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+0 )
167 CHARACTER DIST, PACKIT, TYPE
169 INTEGER I, IOFF, IY, J, JCOUNT, KL, KU, LENJ, MODE
170 REAL ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, REXP,
171 $ sfac, smlnum, texp, tleft, tnorm, tscal, ulp,
173 COMPLEX PLUS1, PLUS2, STAR1
180 EXTERNAL lsame, icamax, slamch, slarnd, clarnd
187 INTRINSIC abs, cmplx, max, min,
REAL, SQRT
191 path( 1: 1 ) =
'Complex precision'
193 unfl = slamch(
'Safe minimum' )
194 ulp = slamch(
'Epsilon' )*slamch(
'Base' )
196 bignum = ( one-ulp ) / smlnum
197 CALL slabad( smlnum, bignum )
198 IF( ( imat.GE.6 .AND. imat.LE.9 ) .OR. imat.EQ.17 )
THEN
212 upper = lsame( uplo,
'U' )
214 CALL clatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
217 ioff = 1 + max( 0, kd-n+1 )
221 CALL clatb4( path, -imat, n, n,
TYPE, KL, KU, ANORM, MODE,
232 CALL clatms( 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 ) =
REAL( j )
277 DO 70 i = 2, min( kd+1, n-j+1 )
280 ab( 1, j ) =
REAL( j )
289 ab( 1, 2 ) = tnorm*clarnd( 5, iseed )
291 CALL clarnv( 2, iseed, lenj, work )
293 ab( 1, 2*( j+1 ) ) = tnorm*work( j )
296 ab( 2, 1 ) = tnorm*clarnd( 5, iseed )
298 CALL clarnv( 2, iseed, lenj, work )
300 ab( 2, 2*j+1 ) = tnorm*work( j )
303 ELSE IF( kd.GT.1 )
THEN
321 star1 = tnorm*clarnd( 5, iseed )
323 plus1 = sfac*clarnd( 5, iseed )
325 plus2 = star1 / plus1
331 plus1 = star1 / plus2
336 rexp = slarnd( 2, iseed )
337 IF( rexp.LT.zero )
THEN
338 star1 = -sfac**( one-rexp )*clarnd( 5, iseed )
340 star1 = sfac**( one+rexp )*clarnd( 5, iseed )
348 CALL ccopy( n-1, work, 1, ab( kd, 2 ), ldab )
349 CALL ccopy( n-2, work( n+1 ), 1, ab( kd-1, 3 ), ldab )
351 CALL ccopy( n-1, work, 1, ab( 2, 1 ), ldab )
352 CALL ccopy( 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 clarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
370 ab( kd+1, j ) = clarnd( 5, iseed )*two
374 lenj = min( n-j, kd )
376 $
CALL clarnv( 4, iseed, lenj, ab( 2, j ) )
377 ab( 1, j ) = clarnd( 5, iseed )*two
383 CALL clarnv( 2, iseed, n, b )
384 iy = icamax( n, b, 1 )
385 bnorm = abs( b( iy ) )
386 bscal = bignum / max( one, bnorm )
387 CALL csscal( n, bscal, b, 1 )
389 ELSE IF( imat.EQ.11 )
THEN
395 CALL clarnv( 2, iseed, n, b )
396 tscal = one /
REAL( kd+1 )
399 lenj = min( j-1, kd )
401 CALL clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
402 CALL csscal( lenj, tscal, ab( kd+2-lenj, j ), 1 )
404 ab( kd+1, j ) = clarnd( 5, iseed )
406 ab( kd+1, n ) = smlnum*ab( kd+1, n )
409 lenj = min( n-j, kd )
411 CALL clarnv( 4, iseed, lenj, ab( 2, j ) )
412 CALL csscal( lenj, tscal, ab( 2, j ), 1 )
414 ab( 1, j ) = clarnd( 5, iseed )
416 ab( 1, 1 ) = smlnum*ab( 1, 1 )
419 ELSE IF( imat.EQ.12 )
THEN
425 CALL clarnv( 2, iseed, n, b )
428 lenj = min( j-1, kd )
430 $
CALL clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
431 ab( kd+1, j ) = clarnd( 5, iseed )
433 ab( kd+1, n ) = smlnum*ab( kd+1, n )
436 lenj = min( n-j, kd )
438 $
CALL clarnv( 4, iseed, lenj, ab( 2, j ) )
439 ab( 1, j ) = clarnd( 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*clarnd( 5, iseed )
459 ab( kd+1, j ) = clarnd( 5, iseed )
468 DO 200 i = 2, min( n-j+1, kd+1 )
471 IF( jcount.LE.2 )
THEN
472 ab( 1, j ) = smlnum*clarnd( 5, iseed )
474 ab( 1, j ) = clarnd( 5, iseed )
488 b( i-1 ) = smlnum*clarnd( 5, iseed )
492 DO 230 i = 1, n - 1, 2
494 b( i+1 ) = smlnum*clarnd( 5, iseed )
498 ELSE IF( imat.EQ.14 )
THEN
504 texp = one /
REAL( kd+1 )
506 CALL clarnv( 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 ) = cmplx( -one, -one )
514 ab( kd+1, j ) = tscal*clarnd( 5, iseed )
516 b( n ) = cmplx( 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 ) = cmplx( -one, -one )
524 ab( 1, j ) = tscal*clarnd( 5, iseed )
526 b( 1 ) = cmplx( one, one )
529 ELSE IF( imat.EQ.15 )
THEN
536 lenj = min( j, kd+1 )
537 CALL clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
539 ab( kd+1, j ) = clarnd( 5, iseed )*two
546 lenj = min( n-j+1, kd+1 )
547 CALL clarnv( 4, iseed, lenj, ab( 1, j ) )
549 ab( 1, j ) = clarnd( 5, iseed )*two
555 CALL clarnv( 2, iseed, n, b )
556 CALL csscal( 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 /
REAL( 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 /
REAL( KD+2 ) )
583 ab( kd+1, i-1 ) = one
584 b( i-1 ) = texp*
REAL( ( kd+1 )*( kd+1 )+kd )
588 b( max( 1, j-kd+1 ) ) = (
REAL( KD+2 ) /
589 $
REAL( 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 /
REAL( 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 $
REAL( KD+2 ) ) /
REAL( KD+3 )
603 b( i+1 ) = texp*
REAL( ( kd+1 )*( kd+1 )+kd )
607 b( min( n, j+kd-1 ) ) = (
REAL( KD+2 ) /
608 $
REAL( KD+3 ) )*tscal
613 ELSE IF( imat.EQ.17 )
THEN
621 lenj = min( j-1, kd )
622 CALL clarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
623 ab( kd+1, j ) =
REAL( j )
627 lenj = min( n-j, kd )
629 $
CALL clarnv( 4, iseed, lenj, ab( 2, j ) )
630 ab( 1, j ) =
REAL( j )
636 CALL clarnv( 2, iseed, n, b )
637 iy = icamax( n, b, 1 )
638 bnorm = abs( b( iy ) )
639 bscal = bignum / max( one, bnorm )
640 CALL csscal( n, bscal, b, 1 )
642 ELSE IF( imat.EQ.18 )
THEN
649 tleft = bignum /
REAL( kd+1 )
650 tscal = bignum*(
REAL( KD+1 ) /
REAL( KD+2 ) )
653 lenj = min( j, kd+1 )
654 CALL clarnv( 5, iseed, lenj, ab( kd+2-lenj, j ) )
655 CALL slarnv( 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 clarnv( 5, iseed, lenj, ab( 1, j ) )
664 CALL slarnv( 1, iseed, lenj, rwork )
666 ab( i, j ) = ab( i, j )*( tleft+rwork( i )*tscal )
670 CALL clarnv( 2, iseed, n, b )
671 CALL csscal( n, two, b, 1 )
676 IF( .NOT.lsame( trans,
'N' ) )
THEN
679 lenj = min( n-2*j+1, kd+1 )
680 CALL cswap( 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 cswap( lenj, ab( 1, j ), 1, ab( lenj, n-j+2-lenj ),
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine clattb(IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, LDAB, B, WORK, RWORK, INFO)
CLATTB
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine csscal(N, SA, CX, INCX)
CSSCAL