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
187 INTRINSIC abs, cmplx, max, min,
REAL, sqrt
191 path( 1: 1 ) =
'Complex precision'
193 unfl =
slamch(
'Safe minimum' )
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
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
385 bnorm = abs(
b( iy ) )
386 bscal = bignum / max( one, bnorm )
389 ELSE IF( imat.EQ.11 )
THEN
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
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 )
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
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 )
638 bnorm = abs(
b( iy ) )
639 bscal = bignum / max( one, bnorm )
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 )
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
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
REAL function slarnd(IDIST, ISEED)
SLARND
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
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.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
COMPLEX function clarnd(IDIST, ISEED)
CLARND
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine csscal(N, SA, CX, INCX)
CSSCAL
INTEGER function icamax(N, CX, INCX)
ICAMAX