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
187 INTRINSIC abs, dble, dcmplx, max, min, sqrt
191 path( 1: 1 ) =
'Zomplex precision'
193 unfl =
dlamch(
'Safe minimum' )
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
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
385 bnorm = abs(
b( iy ) )
386 bscal = bignum / max( one, bnorm )
389 ELSE IF( imat.EQ.11 )
THEN
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
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 )
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
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 )
638 bnorm = abs(
b( iy ) )
639 bscal = bignum / max( one, bnorm )
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 )
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 zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
LOGICAL function lsame(CA, CB)
LSAME
COMPLEX *16 function zlarnd(IDIST, ISEED)
ZLARND
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zlattb(IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, LDAB, B, WORK, RWORK, INFO)
ZLATTB
subroutine dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine dlabad(SMALL, LARGE)
DLABAD
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
DOUBLE PRECISION function dlarnd(IDIST, ISEED)
DLARND
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV 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
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
INTEGER function izamax(N, ZX, INCX)
IZAMAX
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4