131 SUBROUTINE clattp( IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, B, WORK,
140 CHARACTER diag, trans, uplo
141 INTEGER imat, info, n
146 COMPLEX ap( * ),
b( * ), work( * )
153 parameter( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+0 )
157 CHARACTER dist, packit, type
159 INTEGER i, iy,
j, jc, jcnext, jcount, jj, jl, jr, jx,
161 REAL anorm, bignum, bnorm, bscal, c, cndnum, rexp,
162 $ sfac, smlnum, t, texp, tleft, tscal, ulp, unfl,
164 COMPLEX ctemp, plus1, plus2, ra, rb, s, star1
178 INTRINSIC abs, cmplx, conjg, max,
REAL, sqrt
182 path( 1: 1 ) =
'Complex precision'
184 unfl =
slamch(
'Safe minimum' )
187 bignum = ( one-ulp ) / smlnum
188 CALL
slabad( smlnum, bignum )
189 IF( ( imat.GE.7 .AND. imat.LE.10 ) .OR. imat.EQ.18 )
THEN
203 upper =
lsame( uplo,
'U' )
205 CALL
clatb4( path, imat, n, n, type, kl, ku, anorm, mode,
209 CALL
clatb4( path, -imat, n, n, type, kl, ku, anorm, mode,
217 CALL
clatms( 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.25*
clarnd( 5, iseed )
333 plus1 = sfac*
clarnd( 5, iseed )
335 plus2 = star1 / plus1
341 plus1 = star1 / plus2
343 IF( rexp.LT.zero )
THEN
344 star1 = -sfac**( one-rexp )*
clarnd( 5, iseed )
346 star1 = sfac**( one+rexp )*
clarnd( 5, iseed )
351 x = sqrt( cndnum ) - one / sqrt( cndnum )
353 y = sqrt( two /
REAL( 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
crotg( ra, rb, c, s )
412 ctemp = c*ap( jx+
j ) + s*ap( jx+
j+1 )
413 ap( jx+
j+1 ) = -conjg( s )*ap( jx+
j ) +
423 $ CALL
crot(
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
crotg( ra, rb, c, s )
442 $ CALL
crot( 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 ) = -conjg( s )*ap( jx+
j-i ) -
460 ap( jc+1 ) = -ap( jc+1 )
469 ELSE IF( imat.EQ.11 )
THEN
478 CALL
clarnv( 4, iseed,
j-1, ap( jc ) )
479 ap( jc+
j-1 ) =
clarnd( 5, iseed )*two
486 $ CALL
clarnv( 4, iseed, n-
j, ap( jc+1 ) )
487 ap( jc ) =
clarnd( 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,
REAL( N-1 ) )
511 CALL
clarnv( 4, iseed,
j-1, ap( jc ) )
512 CALL
csscal(
j-1, tscal, ap( jc ), 1 )
513 ap( jc+
j-1 ) =
clarnd( 5, iseed )
516 ap( n*( n+1 ) / 2 ) = smlnum*ap( n*( n+1 ) / 2 )
520 CALL
clarnv( 2, iseed, n-
j, ap( jc+1 ) )
521 CALL
csscal( n-
j, tscal, ap( jc+1 ), 1 )
522 ap( jc ) =
clarnd( 5, iseed )
525 ap( 1 ) = smlnum*ap( 1 )
528 ELSE IF( imat.EQ.13 )
THEN
538 CALL
clarnv( 4, iseed,
j-1, ap( jc ) )
539 ap( jc+
j-1 ) =
clarnd( 5, iseed )
542 ap( n*( n+1 ) / 2 ) = smlnum*ap( n*( n+1 ) / 2 )
546 CALL
clarnv( 4, iseed, n-
j, ap( jc+1 ) )
547 ap( jc ) =
clarnd( 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*
clarnd( 5, iseed )
569 ap( jc+
j-1 ) =
clarnd( 5, iseed )
583 IF( jcount.LE.2 )
THEN
584 ap( jc ) = smlnum*
clarnd( 5, iseed )
586 ap( jc ) =
clarnd( 5, iseed )
601 b( i-1 ) = smlnum*
clarnd( 5, iseed )
605 DO 290 i = 1, n - 1, 2
607 b( i+1 ) = smlnum*
clarnd( 5, iseed )
611 ELSE IF( imat.EQ.15 )
THEN
617 texp = one / max( one,
REAL( N-1 ) )
627 $ ap( jc+
j-2 ) = cmplx( -one, -one )
628 ap( jc+
j-1 ) = tscal*
clarnd( 5, iseed )
631 b( n ) = cmplx( one, one )
639 $ ap( jc+1 ) = cmplx( -one, -one )
640 ap( jc ) = tscal*
clarnd( 5, iseed )
643 b( 1 ) = cmplx( one, one )
646 ELSE IF( imat.EQ.16 )
THEN
654 CALL
clarnv( 4, iseed,
j, ap( jc ) )
656 ap( jc+
j-1 ) =
clarnd( 5, iseed )*two
665 CALL
clarnv( 4, iseed, n-
j+1, ap( jc ) )
667 ap( jc ) =
clarnd( 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 /
REAL( n+1 )
695 b(
j ) = texp*( one-ulp )
697 ap( jc ) = -( tscal /
REAL( N+1 ) ) /
REAL( n+2 )
699 b(
j-1 ) = texp*
REAL( n*n+n-1 )
703 b( 1 ) = (
REAL( N+1 ) /
REAL( N+2 ) )*tscal
706 DO 380
j = 1, n - 1, 2
707 ap( jc+n-
j ) = -tscal /
REAL( n+1 )
709 b(
j ) = texp*( one-ulp )
711 ap( jc+n-
j-1 ) = -( tscal /
REAL( N+1 ) ) /
REAL( n+2 )
713 b(
j+1 ) = texp*
REAL( n*n+n-1 )
717 b( n ) = (
REAL( N+1 ) /
REAL( N+2 ) )*tscal
720 ELSE IF( imat.EQ.18 )
THEN
729 CALL
clarnv( 4, iseed,
j-1, ap( jc ) )
737 $ CALL
clarnv( 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,
REAL( N-1 ) )
759 tscal = bignum*(
REAL( N-1 ) / max( one,
REAL( N ) ) )
763 CALL
clarnv( 5, iseed,
j, ap( jc ) )
764 CALL
slarnv( 1, iseed,
j, rwork )
766 ap( jc+i-1 ) = ap( jc+i-1 )*( tleft+rwork( i )*tscal )
773 CALL
clarnv( 5, iseed, n-
j+1, ap( jc ) )
774 CALL
slarnv( 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 )
subroutine crot(N, CX, INCX, CY, INCY, C, S)
CROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors...
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine crotg(CA, CB, C, S)
CROTG
integer function icamax(N, CX, INCX)
ICAMAX
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
complex function clarnd(IDIST, ISEED)
CLARND
logical function lsame(CA, CB)
LSAME
real function slamch(CMACH)
SLAMCH
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 clattp(IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, B, WORK, RWORK, INFO)
CLATTP
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine csscal(N, SA, CX, INCX)
CSSCAL