131 SUBROUTINE zlattp( IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, B, WORK,
140 CHARACTER diag, trans, uplo
141 INTEGER imat, info, n
145 DOUBLE PRECISION rwork( * )
146 COMPLEX*16 ap( * ),
b( * ), work( * )
152 DOUBLE PRECISION one, two, zero
153 parameter( one = 1.0d+0, two = 2.0d+0, zero = 0.0d+0 )
157 CHARACTER dist, packit, type
159 INTEGER i, iy,
j, jc, jcnext, jcount, jj, jl, jr, jx,
161 DOUBLE PRECISION anorm, bignum, bnorm, bscal, c, cndnum, rexp,
162 $ sfac, smlnum, t, texp, tleft, tscal, ulp, unfl,
164 COMPLEX*16 ctemp, plus1, plus2, ra, rb, s, star1
178 INTRINSIC abs, dble, dcmplx, dconjg, max, sqrt
182 path( 1: 1 ) =
'Zomplex precision'
184 unfl =
dlamch(
'Safe minimum' )
187 bignum = ( one-ulp ) / smlnum
188 CALL
dlabad( smlnum, bignum )
189 IF( ( imat.GE.7 .AND. imat.LE.10 ) .OR. imat.EQ.18 )
THEN
203 upper =
lsame( uplo,
'U' )
205 CALL
zlatb4( path, imat, n, n, type, kl, ku, anorm, mode,
209 CALL
zlatb4( path, -imat, n, n, type, kl, ku, anorm, mode,
217 CALL
zlatms( n, n, dist, iseed, type, rwork, mode, cndnum,
218 $ anorm, kl, ku, packit, ap, n, work, info )
225 ELSE IF( imat.EQ.7 )
THEN
252 ELSE IF( imat.LE.10 )
THEN
331 star1 = 0.25d0*
zlarnd( 5, iseed )
333 plus1 = sfac*
zlarnd( 5, iseed )
335 plus2 = star1 / plus1
341 plus1 = star1 / plus2
343 IF( rexp.LT.zero )
THEN
344 star1 = -sfac**( one-rexp )*
zlarnd( 5, iseed )
346 star1 = sfac**( one+rexp )*
zlarnd( 5, iseed )
351 x = sqrt( cndnum ) - one / sqrt( cndnum )
353 y = sqrt( two / dble( n-2 ) )*
x
368 $ ap( jc+
j-1 ) = work(
j-2 )
370 $ ap( jc+
j-2 ) = work( n+
j-3 )
389 ap( jc+1 ) = work(
j-1 )
391 $ ap( jc+2 ) = work( n+
j-1 )
403 ra = ap( jcnext+
j-1 )
405 CALL
zrotg( ra, rb, c, s )
412 ctemp = c*ap( jx+
j ) + s*ap( jx+
j+1 )
413 ap( jx+
j+1 ) = -dconjg( s )*ap( jx+
j ) +
423 $ CALL
zrot(
j-1, ap( jcnext ), 1, ap( jc ), 1, -c, -s )
427 ap( jcnext+
j-1 ) = -ap( jcnext+
j-1 )
433 jcnext = jc + n -
j + 1
436 CALL
zrotg( ra, rb, c, s )
442 $ CALL
zrot( n-
j-1, ap( jcnext+1 ), 1, ap( jc+2 ), 1, c,
450 ctemp = -c*ap( jx+
j-i ) + s*ap( jx+
j-i+1 )
451 ap( jx+
j-i+1 ) = -dconjg( s )*ap( jx+
j-i ) -
460 ap( jc+1 ) = -ap( jc+1 )
469 ELSE IF( imat.EQ.11 )
THEN
478 CALL
zlarnv( 4, iseed,
j-1, ap( jc ) )
479 ap( jc+
j-1 ) =
zlarnd( 5, iseed )*two
486 $ CALL
zlarnv( 4, iseed, n-
j, ap( jc+1 ) )
487 ap( jc ) =
zlarnd( 5, iseed )*two
496 bnorm = abs(
b( iy ) )
497 bscal = bignum / max( one, bnorm )
500 ELSE IF( imat.EQ.12 )
THEN
507 tscal = one / max( one, dble( n-1 ) )
511 CALL
zlarnv( 4, iseed,
j-1, ap( jc ) )
512 CALL
zdscal(
j-1, tscal, ap( jc ), 1 )
513 ap( jc+
j-1 ) =
zlarnd( 5, iseed )
516 ap( n*( n+1 ) / 2 ) = smlnum*ap( n*( n+1 ) / 2 )
520 CALL
zlarnv( 2, iseed, n-
j, ap( jc+1 ) )
521 CALL
zdscal( n-
j, tscal, ap( jc+1 ), 1 )
522 ap( jc ) =
zlarnd( 5, iseed )
525 ap( 1 ) = smlnum*ap( 1 )
528 ELSE IF( imat.EQ.13 )
THEN
538 CALL
zlarnv( 4, iseed,
j-1, ap( jc ) )
539 ap( jc+
j-1 ) =
zlarnd( 5, iseed )
542 ap( n*( n+1 ) / 2 ) = smlnum*ap( n*( n+1 ) / 2 )
546 CALL
zlarnv( 4, iseed, n-
j, ap( jc+1 ) )
547 ap( jc ) =
zlarnd( 5, iseed )
550 ap( 1 ) = smlnum*ap( 1 )
553 ELSE IF( imat.EQ.14 )
THEN
561 jc = ( n-1 )*n / 2 + 1
566 IF( jcount.LE.2 )
THEN
567 ap( jc+
j-1 ) = smlnum*
zlarnd( 5, iseed )
569 ap( jc+
j-1 ) =
zlarnd( 5, iseed )
583 IF( jcount.LE.2 )
THEN
584 ap( jc ) = smlnum*
zlarnd( 5, iseed )
586 ap( jc ) =
zlarnd( 5, iseed )
601 b( i-1 ) = smlnum*
zlarnd( 5, iseed )
605 DO 290 i = 1, n - 1, 2
607 b( i+1 ) = smlnum*
zlarnd( 5, iseed )
611 ELSE IF( imat.EQ.15 )
THEN
617 texp = one / max( one, dble( n-1 ) )
627 $ ap( jc+
j-2 ) = dcmplx( -one, -one )
628 ap( jc+
j-1 ) = tscal*
zlarnd( 5, iseed )
631 b( n ) = dcmplx( one, one )
639 $ ap( jc+1 ) = dcmplx( -one, -one )
640 ap( jc ) = tscal*
zlarnd( 5, iseed )
643 b( 1 ) = dcmplx( one, one )
646 ELSE IF( imat.EQ.16 )
THEN
654 CALL
zlarnv( 4, iseed,
j, ap( jc ) )
656 ap( jc+
j-1 ) =
zlarnd( 5, iseed )*two
665 CALL
zlarnv( 4, iseed, n-
j+1, ap( jc ) )
667 ap( jc ) =
zlarnd( 5, iseed )*two
677 ELSE IF( imat.EQ.17 )
THEN
685 tscal = ( one-ulp ) / tscal
686 DO 360
j = 1, n*( n+1 ) / 2
691 jc = ( n-1 )*n / 2 + 1
693 ap( jc ) = -tscal / dble( n+1 )
695 b(
j ) = texp*( one-ulp )
697 ap( jc ) = -( tscal / dble( n+1 ) ) / dble( n+2 )
699 b(
j-1 ) = texp*dble( n*n+n-1 )
703 b( 1 ) = ( dble( n+1 ) / dble( n+2 ) )*tscal
706 DO 380
j = 1, n - 1, 2
707 ap( jc+n-
j ) = -tscal / dble( n+1 )
709 b(
j ) = texp*( one-ulp )
711 ap( jc+n-
j-1 ) = -( tscal / dble( n+1 ) ) / dble( n+2 )
713 b(
j+1 ) = texp*dble( n*n+n-1 )
717 b( n ) = ( dble( n+1 ) / dble( n+2 ) )*tscal
720 ELSE IF( imat.EQ.18 )
THEN
729 CALL
zlarnv( 4, iseed,
j-1, ap( jc ) )
737 $ CALL
zlarnv( 4, iseed, n-
j, ap( jc+1 ) )
747 bnorm = abs(
b( iy ) )
748 bscal = bignum / max( one, bnorm )
751 ELSE IF( imat.EQ.19 )
THEN
758 tleft = bignum / max( one, dble( n-1 ) )
759 tscal = bignum*( dble( n-1 ) / max( one, dble( n ) ) )
763 CALL
zlarnv( 5, iseed,
j, ap( jc ) )
764 CALL
dlarnv( 1, iseed,
j, rwork )
766 ap( jc+i-1 ) = ap( jc+i-1 )*( tleft+rwork( i )*tscal )
773 CALL
zlarnv( 5, iseed, n-
j+1, ap( jc ) )
774 CALL
dlarnv( 1, iseed, n-
j+1, rwork )
776 ap( jc+i-
j ) = ap( jc+i-
j )*
777 $ ( tleft+rwork( i-
j+1 )*tscal )
789 IF( .NOT.
lsame( trans,
'N' ) )
THEN
797 ap( jr-i+
j ) = ap( jl )
811 ap( jl+i-
j ) = ap( jr )
LOGICAL function lsame(CA, CB)
LSAME
COMPLEX *16 function zlarnd(IDIST, ISEED)
ZLARND
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zlattp(IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, B, WORK, RWORK, INFO)
ZLATTP
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 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 zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4