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 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 clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine csscal(N, SA, CX, INCX)
CSSCAL