298 SUBROUTINE clatme( N, DIST, ISEED, D, MODE, COND, DMAX,
300 $ UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM,
310 CHARACTER DIST, RSIGN, SIM, UPPER
311 INTEGER INFO, KL, KU, LDA, MODE, MODES, N
312 REAL ANORM, COND, CONDS
318 COMPLEX A( LDA, * ), D( * ), WORK( * )
325 PARAMETER ( ZERO = 0.0e+0 )
327 PARAMETER ( ONE = 1.0e+0 )
329 parameter( czero = ( 0.0e+0, 0.0e+0 ) )
331 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
335 INTEGER I, IC, ICOLS, IDIST, IINFO, IR, IROWS, IRSIGN,
336 $ ISIM, IUPPER, J, JC, JCR
338 COMPLEX ALPHA, TAU, XNORMS
347 EXTERNAL LSAME, CLANGE, CLARND
355 INTRINSIC abs, conjg, max, mod
371 IF( lsame( dist,
'U' ) )
THEN
373 ELSE IF( lsame( dist,
'S' ) )
THEN
375 ELSE IF( lsame( dist,
'N' ) )
THEN
377 ELSE IF( lsame( dist,
'D' ) )
THEN
385 IF( lsame( rsign,
'T' ) )
THEN
387 ELSE IF( lsame( rsign,
'F' ) )
THEN
395 IF( lsame( upper,
'T' ) )
THEN
397 ELSE IF( lsame( upper,
'F' ) )
THEN
405 IF( lsame( sim,
'T' ) )
THEN
407 ELSE IF( lsame( sim,
'F' ) )
THEN
416 IF( modes.EQ.0 .AND. isim.EQ.1 )
THEN
418 IF( ds( j ).EQ.zero )
427 ELSE IF( idist.EQ.-1 )
THEN
429 ELSE IF( abs( mode ).GT.6 )
THEN
431 ELSE IF( ( mode.NE.0 .AND. abs( mode ).NE.6 ) .AND. cond.LT.one )
434 ELSE IF( irsign.EQ.-1 )
THEN
436 ELSE IF( iupper.EQ.-1 )
THEN
438 ELSE IF( isim.EQ.-1 )
THEN
442 ELSE IF( isim.EQ.1 .AND. abs( modes ).GT.5 )
THEN
444 ELSE IF( isim.EQ.1 .AND. modes.NE.0 .AND. conds.LT.one )
THEN
446 ELSE IF( kl.LT.1 )
THEN
448 ELSE IF( ku.LT.1 .OR. ( ku.LT.n-1 .AND. kl.LT.n-1 ) )
THEN
450 ELSE IF( lda.LT.max( 1, n ) )
THEN
455 CALL xerbla(
'CLATME', -info )
462 iseed( i ) = mod( abs( iseed( i ) ), 4096 )
465 IF( mod( iseed( 4 ), 2 ).NE.1 )
466 $ iseed( 4 ) = iseed( 4 ) + 1
472 CALL clatm1( mode, cond, irsign, idist, iseed, d, n, iinfo )
473 IF( iinfo.NE.0 )
THEN
477 IF( mode.NE.0 .AND. abs( mode ).NE.6 )
THEN
483 temp = max( temp, abs( d( i ) ) )
486 IF( temp.GT.zero )
THEN
493 CALL cscal( n, alpha, d, 1 )
497 CALL claset(
'Full', n, n, czero, czero, a, lda )
498 CALL ccopy( n, d, 1, a, lda+1 )
502 IF( iupper.NE.0 )
THEN
504 CALL clarnv( idist, iseed, jc-1, a( 1, jc ) )
520 CALL slatm1( modes, conds, 0, 0, iseed, ds, n, iinfo )
521 IF( iinfo.NE.0 )
THEN
528 CALL clarge( n, a, lda, iseed, work, iinfo )
529 IF( iinfo.NE.0 )
THEN
537 CALL csscal( n, ds( j ), a( j, 1 ), lda )
538 IF( ds( j ).NE.zero )
THEN
539 CALL csscal( n, one / ds( j ), a( 1, j ), 1 )
548 CALL clarge( n, a, lda, iseed, work, iinfo )
549 IF( iinfo.NE.0 )
THEN
561 DO 60 jcr = kl + 1, n - 1
566 CALL ccopy( irows, a( jcr, ic ), 1, work, 1 )
568 CALL clarfg( irows, xnorms, work( 2 ), 1, tau )
571 alpha = clarnd( 5, iseed )
573 CALL cgemv(
'C', irows, icols, cone, a( jcr, ic+1 ), lda,
574 $ work, 1, czero, work( irows+1 ), 1 )
575 CALL cgerc( irows, icols, -tau, work, 1, work( irows+1 ), 1,
576 $ a( jcr, ic+1 ), lda )
578 CALL cgemv(
'N', n, irows, cone, a( 1, jcr ), lda, work, 1,
579 $ czero, work( irows+1 ), 1 )
580 CALL cgerc( n, irows, -conjg( tau ), work( irows+1 ), 1,
581 $ work, 1, a( 1, jcr ), lda )
583 a( jcr, ic ) = xnorms
584 CALL claset(
'Full', irows-1, 1, czero, czero,
585 $ a( jcr+1, ic ), lda )
587 CALL cscal( icols+1, alpha, a( jcr, ic ), lda )
588 CALL cscal( n, conjg( alpha ), a( 1, jcr ), 1 )
590 ELSE IF( ku.LT.n-1 )
THEN
594 DO 70 jcr = ku + 1, n - 1
599 CALL ccopy( icols, a( ir, jcr ), lda, work, 1 )
601 CALL clarfg( icols, xnorms, work( 2 ), 1, tau )
604 CALL clacgv( icols-1, work( 2 ), 1 )
605 alpha = clarnd( 5, iseed )
607 CALL cgemv(
'N', irows, icols, cone, a( ir+1, jcr ), lda,
608 $ work, 1, czero, work( icols+1 ), 1 )
609 CALL cgerc( irows, icols, -tau, work( icols+1 ), 1, work, 1,
610 $ a( ir+1, jcr ), lda )
612 CALL cgemv(
'C', icols, n, cone, a( jcr, 1 ), lda, work, 1,
613 $ czero, work( icols+1 ), 1 )
614 CALL cgerc( icols, n, -conjg( tau ), work, 1,
615 $ work( icols+1 ), 1, a( jcr, 1 ), lda )
617 a( ir, jcr ) = xnorms
618 CALL claset(
'Full', 1, icols-1, czero, czero,
619 $ a( ir, jcr+1 ), lda )
621 CALL cscal( irows+1, alpha, a( ir, jcr ), 1 )
622 CALL cscal( n, conjg( alpha ), a( jcr, 1 ), lda )
628 IF( anorm.GE.zero )
THEN
629 temp = clange(
'M', n, n, a, lda, tempa )
630 IF( temp.GT.zero )
THEN
631 ralpha = anorm / temp
633 CALL csscal( n, ralpha, a( 1, j ), 1 )