138 SUBROUTINE zlattr( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B,
139 $ work, rwork, info )
147 CHARACTER diag, trans, uplo
148 INTEGER imat, info, lda, n
152 DOUBLE PRECISION rwork( * )
153 COMPLEX*16 a( lda, * ),
b( * ), work( * )
159 DOUBLE PRECISION one, two, zero
160 parameter( one = 1.0d+0, two = 2.0d+0, zero = 0.0d+0 )
166 INTEGER i, iy,
j, jcount, kl, ku, mode
167 DOUBLE PRECISION anorm, bignum, bnorm, bscal, c, cndnum, rexp,
168 $ sfac, smlnum, texp, tleft, tscal, ulp, unfl,
x,
170 COMPLEX*16 plus1, plus2, ra, rb, s, star1
184 INTRINSIC abs, dble, dcmplx, dconjg, max, sqrt
188 path( 1: 1 ) =
'Zomplex precision'
190 unfl =
dlamch(
'Safe minimum' )
193 bignum = ( one-ulp ) / smlnum
194 CALL
dlabad( smlnum, bignum )
195 IF( ( imat.GE.7 .AND. imat.LE.10 ) .OR. imat.EQ.18 )
THEN
209 upper =
lsame( uplo,
'U' )
211 CALL
zlatb4( path, imat, n, n, type, kl, ku, anorm, mode,
214 CALL
zlatb4( path, -imat, n, n, type, kl, ku, anorm, mode,
221 CALL
zlatms( n, n, dist, iseed, type, rwork, mode, cndnum,
222 $ anorm, kl, ku,
'No packing', a, lda, work, info )
229 ELSE IF( imat.EQ.7 )
THEN
252 ELSE IF( imat.LE.10 )
THEN
327 star1 = 0.25d0*
zlarnd( 5, iseed )
329 plus1 = sfac*
zlarnd( 5, iseed )
331 plus2 = star1 / plus1
337 plus1 = star1 / plus2
339 IF( rexp.LT.zero )
THEN
340 star1 = -sfac**( one-rexp )*
zlarnd( 5, iseed )
342 star1 = sfac**( one+rexp )*
zlarnd( 5, iseed )
347 x = sqrt( cndnum ) - 1 / sqrt( cndnum )
349 y = sqrt( 2.d0 / ( n-2 ) )*
x
357 CALL
zcopy( n-3, work, 1, a( 2, 3 ), lda+1 )
359 $ CALL
zcopy( n-4, work( n+1 ), 1, a( 2, 4 ), lda+1 )
368 CALL
zcopy( n-3, work, 1, a( 3, 2 ), lda+1 )
370 $ CALL
zcopy( n-4, work( n+1 ), 1, a( 4, 2 ), lda+1 )
385 CALL
zrotg( ra, rb, c, s )
390 $ CALL
zrot( n-
j-1, a(
j,
j+2 ), lda, a(
j+1,
j+2 ),
396 $ CALL
zrot(
j-1, a( 1,
j+1 ), 1, a( 1,
j ), 1, -c, -s )
400 a(
j,
j+1 ) = -a(
j,
j+1 )
406 CALL
zrotg( ra, rb, c, s )
412 $ CALL
zrot( n-
j-1, a(
j+2,
j+1 ), 1, a(
j+2,
j ), 1, c,
418 $ CALL
zrot(
j-1, a(
j, 1 ), lda, a(
j+1, 1 ), lda, -c,
423 a(
j+1,
j ) = -a(
j+1,
j )
431 ELSE IF( imat.EQ.11 )
THEN
439 CALL
zlarnv( 4, iseed,
j-1, a( 1,
j ) )
445 $ CALL
zlarnv( 4, iseed, n-
j, a(
j+1,
j ) )
454 bnorm = abs(
b( iy ) )
455 bscal = bignum / max( one, bnorm )
458 ELSE IF( imat.EQ.12 )
THEN
465 tscal = one / max( one, dble( n-1 ) )
468 CALL
zlarnv( 4, iseed,
j-1, a( 1,
j ) )
469 CALL
zdscal(
j-1, tscal, a( 1,
j ), 1 )
472 a( n, n ) = smlnum*a( n, n )
476 CALL
zlarnv( 4, iseed, n-
j, a(
j+1,
j ) )
477 CALL
zdscal( n-
j, tscal, a(
j+1,
j ), 1 )
481 a( 1, 1 ) = smlnum*a( 1, 1 )
484 ELSE IF( imat.EQ.13 )
THEN
493 CALL
zlarnv( 4, iseed,
j-1, a( 1,
j ) )
496 a( n, n ) = smlnum*a( n, n )
500 $ CALL
zlarnv( 4, iseed, n-
j, a(
j+1,
j ) )
503 a( 1, 1 ) = smlnum*a( 1, 1 )
506 ELSE IF( imat.EQ.14 )
THEN
518 IF( jcount.LE.2 )
THEN
519 a(
j,
j ) = smlnum*
zlarnd( 5, iseed )
533 IF( jcount.LE.2 )
THEN
534 a(
j,
j ) = smlnum*
zlarnd( 5, iseed )
550 b( i-1 ) = smlnum*
zlarnd( 5, iseed )
554 DO 250 i = 1, n - 1, 2
556 b( i+1 ) = smlnum*
zlarnd( 5, iseed )
560 ELSE IF( imat.EQ.15 )
THEN
566 texp = one / max( one, dble( n-1 ) )
575 $ a(
j-1,
j ) = dcmplx( -one, -one )
576 a(
j,
j ) = tscal*
zlarnd( 5, iseed )
578 b( n ) = dcmplx( one, one )
585 $ a(
j+1,
j ) = dcmplx( -one, -one )
586 a(
j,
j ) = tscal*
zlarnd( 5, iseed )
588 b( 1 ) = dcmplx( one, one )
591 ELSE IF( imat.EQ.16 )
THEN
598 CALL
zlarnv( 4, iseed,
j-1, a( 1,
j ) )
608 $ CALL
zlarnv( 4, iseed, n-
j, a(
j+1,
j ) )
619 ELSE IF( imat.EQ.17 )
THEN
627 tscal = ( one-ulp ) / tscal
636 a( 1,
j ) = -tscal / dble( n+1 )
638 b(
j ) = texp*( one-ulp )
639 a( 1,
j-1 ) = -( tscal / dble( n+1 ) ) / dble( n+2 )
641 b(
j-1 ) = texp*dble( n*n+n-1 )
644 b( 1 ) = ( dble( n+1 ) / dble( n+2 ) )*tscal
646 DO 350
j = 1, n - 1, 2
647 a( n,
j ) = -tscal / dble( n+1 )
649 b(
j ) = texp*( one-ulp )
650 a( n,
j+1 ) = -( tscal / dble( n+1 ) ) / dble( n+2 )
652 b(
j+1 ) = texp*dble( n*n+n-1 )
655 b( n ) = ( dble( n+1 ) / dble( n+2 ) )*tscal
658 ELSE IF( imat.EQ.18 )
THEN
666 CALL
zlarnv( 4, iseed,
j-1, a( 1,
j ) )
672 $ CALL
zlarnv( 4, iseed, n-
j, a(
j+1,
j ) )
681 bnorm = abs(
b( iy ) )
682 bscal = bignum / max( one, bnorm )
685 ELSE IF( imat.EQ.19 )
THEN
692 tleft = bignum / max( one, dble( n-1 ) )
693 tscal = bignum*( dble( n-1 ) / max( one, dble( n ) ) )
696 CALL
zlarnv( 5, iseed,
j, a( 1,
j ) )
697 CALL
dlarnv( 1, iseed,
j, rwork )
699 a( i,
j ) = a( i,
j )*( tleft+rwork( i )*tscal )
704 CALL
zlarnv( 5, iseed, n-
j+1, a(
j,
j ) )
705 CALL
dlarnv( 1, iseed, n-
j+1, rwork )
707 a( i,
j ) = a( i,
j )*( tleft+rwork( i-
j+1 )*tscal )
717 IF( .NOT.
lsame( trans,
'N' ) )
THEN
720 CALL
zswap( n-2*
j+1, a(
j,
j ), lda, a(
j+1, n-
j+1 ),
725 CALL
zswap( n-2*
j+1, a(
j,
j ), 1, a( n-
j+1,
j+1 ),
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 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
subroutine zrotg(CA, CB, C, S)
ZROTG
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine zrot(N, CX, INCX, CY, INCY, C, S)
ZROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors...
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 zlattr(IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, WORK, RWORK, INFO)
ZLATTR
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4