147 CHARACTER DIAG, TRANS, UPLO
148 INTEGER IMAT, INFO, KD, LDAB, N
153 COMPLEX AB( LDAB, * ), B( * ), WORK( * )
160 parameter( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+0 )
164 CHARACTER DIST, PACKIT, TYPE
166 INTEGER I, IOFF, IY, J, JCOUNT, KL, KU, LENJ, MODE
167 REAL ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, REXP,
168 $ SFAC, SMLNUM, TEXP, TLEFT, TNORM, TSCAL, ULP,
170 COMPLEX PLUS1, PLUS2, STAR1
184 INTRINSIC abs, cmplx, max, min, real, sqrt
188 path( 1: 1 ) =
'Complex precision'
190 unfl =
slamch(
'Safe minimum' )
193 bignum = ( one-ulp ) / smlnum
194 CALL slabad( smlnum, bignum )
195 IF( ( imat.GE.6 .AND. imat.LE.9 ) .OR. imat.EQ.17 )
THEN
209 upper =
lsame( uplo,
'U' )
211 CALL clatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
214 ioff = 1 + max( 0, kd-n+1 )
218 CALL clatb4( path, -imat, n, n,
TYPE, KL, KU, ANORM, MODE,
229 CALL clatms( n, n, dist, iseed,
TYPE, RWORK, MODE, CNDNUM,
230 $ ANORM, KL, KU, PACKIT, AB( IOFF, 1 ), LDAB, WORK,
238 ELSE IF( imat.EQ.6 )
THEN
241 DO 10 i = max( 1, kd+2-j ), kd
249 DO 30 i = 2, min( kd+1, n-j+1 )
260 ELSE IF( imat.LE.9 )
THEN
261 tnorm = sqrt( cndnum )
267 DO 50 i = max( 1, kd+2-j ), kd
270 ab( kd+1, j ) = real( j )
274 DO 70 i = 2, min( kd+1, n-j+1 )
277 ab( 1, j ) = real( j )
286 ab( 1, 2 ) = tnorm*
clarnd( 5, iseed )
288 CALL clarnv( 2, iseed, lenj, work )
290 ab( 1, 2*( j+1 ) ) = tnorm*work( j )
293 ab( 2, 1 ) = tnorm*
clarnd( 5, iseed )
295 CALL clarnv( 2, iseed, lenj, work )
297 ab( 2, 2*j+1 ) = tnorm*work( j )
300 ELSE IF( kd.GT.1 )
THEN
318 star1 = tnorm*
clarnd( 5, iseed )
320 plus1 = sfac*
clarnd( 5, iseed )
322 plus2 = star1 / plus1
328 plus1 = star1 / plus2
334 IF( rexp.LT.zero )
THEN
335 star1 = -sfac**( one-rexp )*
clarnd( 5, iseed )
337 star1 = sfac**( one+rexp )*
clarnd( 5, iseed )
345 CALL ccopy( n-1, work, 1, ab( kd, 2 ), ldab )
346 CALL ccopy( n-2, work( n+1 ), 1, ab( kd-1, 3 ), ldab )
348 CALL ccopy( n-1, work, 1, ab( 2, 1 ), ldab )
349 CALL ccopy( n-2, work( n+1 ), 1, ab( 3, 1 ), ldab )
357 ELSE IF( imat.EQ.10 )
THEN
365 lenj = min( j-1, kd )
366 CALL clarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
367 ab( kd+1, j ) =
clarnd( 5, iseed )*two
371 lenj = min( n-j, kd )
373 $
CALL clarnv( 4, iseed, lenj, ab( 2, j ) )
374 ab( 1, j ) =
clarnd( 5, iseed )*two
380 CALL clarnv( 2, iseed, n, b )
382 bnorm = abs( b( iy ) )
383 bscal = bignum / max( one, bnorm )
384 CALL csscal( n, bscal, b, 1 )
386 ELSE IF( imat.EQ.11 )
THEN
392 CALL clarnv( 2, iseed, n, b )
393 tscal = one / real( kd+1 )
396 lenj = min( j-1, kd )
398 CALL clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
399 CALL csscal( lenj, tscal, ab( kd+2-lenj, j ), 1 )
401 ab( kd+1, j ) =
clarnd( 5, iseed )
403 ab( kd+1, n ) = smlnum*ab( kd+1, n )
406 lenj = min( n-j, kd )
408 CALL clarnv( 4, iseed, lenj, ab( 2, j ) )
409 CALL csscal( lenj, tscal, ab( 2, j ), 1 )
411 ab( 1, j ) =
clarnd( 5, iseed )
413 ab( 1, 1 ) = smlnum*ab( 1, 1 )
416 ELSE IF( imat.EQ.12 )
THEN
422 CALL clarnv( 2, iseed, n, b )
425 lenj = min( j-1, kd )
427 $
CALL clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
428 ab( kd+1, j ) =
clarnd( 5, iseed )
430 ab( kd+1, n ) = smlnum*ab( kd+1, n )
433 lenj = min( n-j, kd )
435 $
CALL clarnv( 4, iseed, lenj, ab( 2, j ) )
436 ab( 1, j ) =
clarnd( 5, iseed )
438 ab( 1, 1 ) = smlnum*ab( 1, 1 )
441 ELSE IF( imat.EQ.13 )
THEN
450 DO 180 i = max( 1, kd+1-( j-1 ) ), kd
453 IF( jcount.LE.2 )
THEN
454 ab( kd+1, j ) = smlnum*
clarnd( 5, iseed )
456 ab( kd+1, j ) =
clarnd( 5, iseed )
465 DO 200 i = 2, min( n-j+1, kd+1 )
468 IF( jcount.LE.2 )
THEN
469 ab( 1, j ) = smlnum*
clarnd( 5, iseed )
471 ab( 1, j ) =
clarnd( 5, iseed )
485 b( i-1 ) = smlnum*
clarnd( 5, iseed )
489 DO 230 i = 1, n - 1, 2
491 b( i+1 ) = smlnum*
clarnd( 5, iseed )
495 ELSE IF( imat.EQ.14 )
THEN
501 texp = one / real( kd+1 )
503 CALL clarnv( 4, iseed, n, b )
506 DO 240 i = max( 1, kd+2-j ), kd
509 IF( j.GT.1 .AND. kd.GT.0 )
510 $ ab( kd, j ) = cmplx( -one, -one )
511 ab( kd+1, j ) = tscal*
clarnd( 5, iseed )
513 b( n ) = cmplx( one, one )
516 DO 260 i = 3, min( n-j+1, kd+1 )
519 IF( j.LT.n .AND. kd.GT.0 )
520 $ ab( 2, j ) = cmplx( -one, -one )
521 ab( 1, j ) = tscal*
clarnd( 5, iseed )
523 b( 1 ) = cmplx( one, one )
526 ELSE IF( imat.EQ.15 )
THEN
533 lenj = min( j, kd+1 )
534 CALL clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
536 ab( kd+1, j ) =
clarnd( 5, iseed )*two
543 lenj = min( n-j+1, kd+1 )
544 CALL clarnv( 4, iseed, lenj, ab( 1, j ) )
546 ab( 1, j ) =
clarnd( 5, iseed )*two
552 CALL clarnv( 2, iseed, n, b )
553 CALL csscal( n, two, b, 1 )
555 ELSE IF( imat.EQ.16 )
THEN
563 tscal = ( one-ulp ) / tscal
573 DO 320 i = j, max( 1, j-kd+1 ), -2
574 ab( 1+( j-i ), i ) = -tscal / real( kd+2 )
576 b( i ) = texp*( one-ulp )
577 IF( i.GT.max( 1, j-kd+1 ) )
THEN
578 ab( 2+( j-i ), i-1 ) = -( tscal / real( kd+2 ) )
580 ab( kd+1, i-1 ) = one
581 b( i-1 ) = texp*real( ( kd+1 )*( kd+1 )+kd )
585 b( max( 1, j-kd+1 ) ) = ( real( kd+2 ) /
586 $ real( kd+3 ) )*tscal
591 lenj = min( kd+1, n-j+1 )
592 DO 340 i = j, min( n, j+kd-1 ), 2
593 ab( lenj-( i-j ), j ) = -tscal / real( kd+2 )
595 b( j ) = texp*( one-ulp )
596 IF( i.LT.min( n, j+kd-1 ) )
THEN
597 ab( lenj-( i-j+1 ), i+1 ) = -( tscal /
598 $ real( kd+2 ) ) / real( kd+3 )
600 b( i+1 ) = texp*real( ( kd+1 )*( kd+1 )+kd )
604 b( min( n, j+kd-1 ) ) = ( real( kd+2 ) /
605 $ real( kd+3 ) )*tscal
610 ELSE IF( imat.EQ.17 )
THEN
618 lenj = min( j-1, kd )
619 CALL clarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
620 ab( kd+1, j ) = real( j )
624 lenj = min( n-j, kd )
626 $
CALL clarnv( 4, iseed, lenj, ab( 2, j ) )
627 ab( 1, j ) = real( j )
633 CALL clarnv( 2, iseed, n, b )
635 bnorm = abs( b( iy ) )
636 bscal = bignum / max( one, bnorm )
637 CALL csscal( n, bscal, b, 1 )
639 ELSE IF( imat.EQ.18 )
THEN
646 tleft = bignum / real( kd+1 )
647 tscal = bignum*( real( kd+1 ) / real( kd+2 ) )
650 lenj = min( j, kd+1 )
651 CALL clarnv( 5, iseed, lenj, ab( kd+2-lenj, j ) )
652 CALL slarnv( 1, iseed, lenj, rwork( kd+2-lenj ) )
653 DO 380 i = kd + 2 - lenj, kd + 1
654 ab( i, j ) = ab( i, j )*( tleft+rwork( i )*tscal )
659 lenj = min( n-j+1, kd+1 )
660 CALL clarnv( 5, iseed, lenj, ab( 1, j ) )
661 CALL slarnv( 1, iseed, lenj, rwork )
663 ab( i, j ) = ab( i, j )*( tleft+rwork( i )*tscal )
667 CALL clarnv( 2, iseed, n, b )
668 CALL csscal( n, two, b, 1 )
673 IF( .NOT.
lsame( trans,
'N' ) )
THEN
676 lenj = min( n-2*j+1, kd+1 )
677 CALL cswap( lenj, ab( kd+1, j ), ldab-1,
678 $ ab( kd+2-lenj, n-j+1 ), -1 )
682 lenj = min( n-2*j+1, kd+1 )
683 CALL cswap( lenj, ab( 1, j ), 1, ab( lenj, n-j+2-lenj ),
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
integer function icamax(N, CX, INCX)
ICAMAX
logical function lsame(CA, CB)
LSAME
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
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
complex function clarnd(IDIST, ISEED)
CLARND
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
real function slarnd(IDIST, ISEED)
SLARND
real function slamch(CMACH)
SLAMCH