136 SUBROUTINE clattr( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B,
137 $ WORK, RWORK, INFO )
144 CHARACTER DIAG, TRANS, UPLO
145 INTEGER IMAT, INFO, LDA, N
150 COMPLEX A( LDA, * ), B( * ), WORK( * )
157 parameter( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+0 )
163 INTEGER I, IY, J, JCOUNT, KL, KU, MODE
164 REAL ANORM, BIGNUM, BNORM, BSCAL, C, CNDNUM, REXP,
165 $ sfac, smlnum, texp, tleft, tscal, ulp, unfl, x,
167 COMPLEX PLUS1, PLUS2, RA, RB, S, STAR1
174 EXTERNAL lsame, icamax, slamch, slarnd, clarnd
181 INTRINSIC abs, cmplx, conjg, max, real, sqrt
185 path( 1: 1 ) =
'Complex precision'
187 unfl = slamch(
'Safe minimum' )
188 ulp = slamch(
'Epsilon' )*slamch(
'Base' )
190 bignum = ( one-ulp ) / smlnum
191 IF( ( imat.GE.7 .AND. imat.LE.10 ) .OR. imat.EQ.18 )
THEN
205 upper = lsame( uplo,
'U' )
207 CALL clatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
210 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,
'No packing', a, lda, work, info )
225 ELSE IF( imat.EQ.7 )
THEN
248 ELSE IF( imat.LE.10 )
THEN
323 star1 = 0.25*clarnd( 5, iseed )
325 plus1 = sfac*clarnd( 5, iseed )
327 plus2 = star1 / plus1
333 plus1 = star1 / plus2
334 rexp = slarnd( 2, iseed )
335 IF( rexp.LT.zero )
THEN
336 star1 = -sfac**( one-rexp )*clarnd( 5, iseed )
338 star1 = sfac**( one+rexp )*clarnd( 5, iseed )
343 x = sqrt( cndnum ) - 1 / sqrt( cndnum )
345 y = sqrt( 2. / ( n-2 ) )*x
353 CALL ccopy( n-3, work, 1, a( 2, 3 ), lda+1 )
355 $
CALL ccopy( n-4, work( n+1 ), 1, a( 2, 4 ), lda+1 )
364 CALL ccopy( n-3, work, 1, a( 3, 2 ), lda+1 )
366 $
CALL ccopy( n-4, work( n+1 ), 1, a( 4, 2 ), lda+1 )
381 CALL crotg( ra, rb, c, s )
386 $
CALL crot( n-j-1, a( j, j+2 ), lda, a( j+1, j+2 ),
392 $
CALL crot( j-1, a( 1, j+1 ), 1, a( 1, j ), 1, -c, -s )
396 a( j, j+1 ) = -a( j, j+1 )
402 CALL crotg( ra, rb, c, s )
408 $
CALL crot( n-j-1, a( j+2, j+1 ), 1, a( j+2, j ), 1, c,
414 $
CALL crot( j-1, a( j, 1 ), lda, a( j+1, 1 ), lda, -c,
419 a( j+1, j ) = -a( j+1, j )
427 ELSE IF( imat.EQ.11 )
THEN
435 CALL clarnv( 4, iseed, j-1, a( 1, j ) )
436 a( j, j ) = clarnd( 5, iseed )*two
441 $
CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
442 a( j, j ) = clarnd( 5, iseed )*two
448 CALL clarnv( 2, iseed, n, b )
449 iy = icamax( n, b, 1 )
450 bnorm = abs( b( iy ) )
451 bscal = bignum / max( one, bnorm )
452 CALL csscal( n, bscal, b, 1 )
454 ELSE IF( imat.EQ.12 )
THEN
460 CALL clarnv( 2, iseed, n, b )
461 tscal = one / max( one, real( n-1 ) )
464 CALL clarnv( 4, iseed, j-1, a( 1, j ) )
465 CALL csscal( j-1, tscal, a( 1, j ), 1 )
466 a( j, j ) = clarnd( 5, iseed )
468 a( n, n ) = smlnum*a( n, n )
472 CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
473 CALL csscal( n-j, tscal, a( j+1, j ), 1 )
475 a( j, j ) = clarnd( 5, iseed )
477 a( 1, 1 ) = smlnum*a( 1, 1 )
480 ELSE IF( imat.EQ.13 )
THEN
486 CALL clarnv( 2, iseed, n, b )
489 CALL clarnv( 4, iseed, j-1, a( 1, j ) )
490 a( j, j ) = clarnd( 5, iseed )
492 a( n, n ) = smlnum*a( n, n )
496 $
CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
497 a( j, j ) = clarnd( 5, iseed )
499 a( 1, 1 ) = smlnum*a( 1, 1 )
502 ELSE IF( imat.EQ.14 )
THEN
514 IF( jcount.LE.2 )
THEN
515 a( j, j ) = smlnum*clarnd( 5, iseed )
517 a( j, j ) = clarnd( 5, iseed )
529 IF( jcount.LE.2 )
THEN
530 a( j, j ) = smlnum*clarnd( 5, iseed )
532 a( j, j ) = clarnd( 5, iseed )
546 b( i-1 ) = smlnum*clarnd( 5, iseed )
550 DO 250 i = 1, n - 1, 2
552 b( i+1 ) = smlnum*clarnd( 5, iseed )
556 ELSE IF( imat.EQ.15 )
THEN
562 texp = one / max( one, real( n-1 ) )
564 CALL clarnv( 4, iseed, n, b )
571 $ a( j-1, j ) = cmplx( -one, -one )
572 a( j, j ) = tscal*clarnd( 5, iseed )
574 b( n ) = cmplx( one, one )
581 $ a( j+1, j ) = cmplx( -one, -one )
582 a( j, j ) = tscal*clarnd( 5, iseed )
584 b( 1 ) = cmplx( one, one )
587 ELSE IF( imat.EQ.16 )
THEN
594 CALL clarnv( 4, iseed, j-1, a( 1, j ) )
596 a( j, j ) = clarnd( 5, iseed )*two
604 $
CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
606 a( j, j ) = clarnd( 5, iseed )*two
612 CALL clarnv( 2, iseed, n, b )
613 CALL csscal( n, two, b, 1 )
615 ELSE IF( imat.EQ.17 )
THEN
623 tscal = ( one-ulp ) / tscal
632 a( 1, j ) = -tscal / real( n+1 )
634 b( j ) = texp*( one-ulp )
635 a( 1, j-1 ) = -( tscal / real( n+1 ) ) / real( n+2 )
637 b( j-1 ) = texp*real( n*n+n-1 )
640 b( 1 ) = ( real( n+1 ) / real( n+2 ) )*tscal
642 DO 350 j = 1, n - 1, 2
643 a( n, j ) = -tscal / real( n+1 )
645 b( j ) = texp*( one-ulp )
646 a( n, j+1 ) = -( tscal / real( n+1 ) ) / real( n+2 )
648 b( j+1 ) = texp*real( n*n+n-1 )
651 b( n ) = ( real( n+1 ) / real( n+2 ) )*tscal
654 ELSE IF( imat.EQ.18 )
THEN
662 CALL clarnv( 4, iseed, j-1, a( 1, j ) )
668 $
CALL clarnv( 4, iseed, n-j, a( j+1, j ) )
675 CALL clarnv( 2, iseed, n, b )
676 iy = icamax( n, b, 1 )
677 bnorm = abs( b( iy ) )
678 bscal = bignum / max( one, bnorm )
679 CALL csscal( n, bscal, b, 1 )
681 ELSE IF( imat.EQ.19 )
THEN
688 tleft = bignum / max( one, real( n-1 ) )
689 tscal = bignum*( real( n-1 ) / max( one, real( n ) ) )
692 CALL clarnv( 5, iseed, j, a( 1, j ) )
693 CALL slarnv( 1, iseed, j, rwork )
695 a( i, j ) = a( i, j )*( tleft+rwork( i )*tscal )
700 CALL clarnv( 5, iseed, n-j+1, a( j, j ) )
701 CALL slarnv( 1, iseed, n-j+1, rwork )
703 a( i, j ) = a( i, j )*( tleft+rwork( i-j+1 )*tscal )
707 CALL clarnv( 2, iseed, n, b )
708 CALL csscal( n, two, b, 1 )
713 IF( .NOT.lsame( trans,
'N' ) )
THEN
716 CALL cswap( n-2*j+1, a( j, j ), lda, a( j+1, n-j+1 ),
721 CALL cswap( n-2*j+1, a( j, j ), 1, a( n-j+1, j+1 ),
subroutine clatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
CLATB4
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
subroutine clattr(imat, uplo, trans, diag, iseed, n, a, lda, b, work, rwork, info)
CLATTR
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
subroutine slarnv(idist, iseed, n, x)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine clarnv(idist, iseed, n, x)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
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 crotg(a, b, c, s)
CROTG generates a Givens rotation with real cosine and complex sine.
subroutine csscal(n, sa, cx, incx)
CSSCAL
subroutine cswap(n, cx, incx, cy, incy)
CSWAP