172 $ thresh, tsterr, nmax, a, afac, ainv,
b, x,
173 $ xact, work, rwork, iwork, nout )
182 INTEGER nmax, nn, nnb, nns, nout
187 INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
189 COMPLEX a( * ), afac( * ), ainv( * ),
b( * ),
190 $ work( * ), x( * ), xact( * )
197 parameter( zero = 0.0e+0, one = 1.0e+0 )
199 parameter( onehalf = 0.5e+0 )
201 parameter( eight = 8.0e+0, sevten = 17.0e+0 )
203 parameter( czero = ( 0.0e+0, 0.0e+0 ) )
205 parameter( ntypes = 11 )
207 parameter( ntests = 7 )
210 LOGICAL trfcon, zerot
211 CHARACTER dist, type, uplo, xtype
212 CHARACTER*3 path, matpath
213 INTEGER i, i1, i2, imat, in, inb, info, ioff, irhs,
214 $ itemp, itemp2, iuplo, izero,
j, k, kl, ku, lda,
215 $ lwork, mode, n, nb, nerrs, nfail, nimat, nrhs,
217 REAL alpha, anorm, cndnum, const, lam_max, lam_min,
218 $ rcond, rcondc, stemp
222 INTEGER iseed( 4 ), iseedy( 4 )
223 REAL result( ntests )
224 COMPLEX block( 2, 2 ), cdummy( 1 )
237 INTRINSIC abs, max, min, sqrt
245 COMMON / infoc / infot, nunit, ok, lerr
246 COMMON / srnamc / srnamt
249 DATA iseedy / 1988, 1989, 1990, 1991 /
250 DATA uplos /
'U',
'L' /
256 alpha = ( one+sqrt( sevten ) ) / eight
260 path( 1: 1 ) =
'Complex precision'
265 matpath( 1: 1 ) =
'Complex precision'
266 matpath( 2: 3 ) =
'SY'
272 iseed( i ) = iseedy( i )
278 $ CALL
cerrsy( path, nout )
300 DO 260 imat = 1, nimat
304 IF( .NOT.dotype( imat ) )
309 zerot = imat.GE.3 .AND. imat.LE.6
310 IF( zerot .AND. n.LT.imat-2 )
316 uplo = uplos( iuplo )
320 IF( imat.NE.ntypes )
THEN
325 CALL
clatb4( matpath, imat, n, n, type, kl, ku, anorm,
326 $ mode, cndnum, dist )
331 CALL
clatms( n, n, dist, iseed, type, rwork, mode,
332 $ cndnum, anorm, kl, ku, uplo, a, lda,
338 CALL
alaerh( path,
'CLATMS', info, 0, uplo, n, n,
339 $ -1, -1, -1, imat, nfail, nerrs, nout )
353 ELSE IF( imat.EQ.4 )
THEN
363 IF( iuplo.EQ.1 )
THEN
364 ioff = ( izero-1 )*lda
365 DO 20 i = 1, izero - 1
375 DO 40 i = 1, izero - 1
385 IF( iuplo.EQ.1 )
THEN
421 CALL
clatsy( uplo, n, a, lda, iseed )
442 CALL
clacpy( uplo, n, n, a, lda, afac, lda )
449 lwork = max( 2, nb )*lda
450 srnamt =
'CSYTRF_ROOK'
460 IF( iwork( k ).LT.0 )
THEN
461 IF( iwork( k ).NE.-k )
THEN
465 ELSE IF( iwork( k ).NE.k )
THEN
474 $ CALL
alaerh( path,
'CSYTRF_ROOK', info, k,
475 $ uplo, n, n, -1, -1, nb, imat,
476 $ nfail, nerrs, nout )
489 CALL
csyt01_rook( uplo, n, a, lda, afac, lda, iwork,
490 $ ainv, lda, rwork, result( 1 ) )
499 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
500 CALL
clacpy( uplo, n, n, afac, lda, ainv, lda )
501 srnamt =
'CSYTRI_ROOK'
508 $ CALL
alaerh( path,
'CSYTRI_ROOK', info, -1,
509 $ uplo, n, n, -1, -1, -1, imat,
510 $ nfail, nerrs, nout )
515 CALL
csyt03( uplo, n, a, lda, ainv, lda, work, lda,
516 $ rwork, rcondc, result( 2 ) )
524 IF( result( k ).GE.thresh )
THEN
525 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
526 $ CALL
alahd( nout, path )
527 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
540 const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) ) /
543 IF( iuplo.EQ.1 )
THEN
552 IF( iwork( k ).GT.zero )
THEN
557 stemp =
clange(
'M', k-1, 1,
558 $ afac( ( k-1 )*lda+1 ), lda, rwork )
564 stemp =
clange(
'M', k-2, 2,
565 $ afac( ( k-2 )*lda+1 ), lda, rwork )
572 stemp = stemp - const + thresh
573 IF( stemp.GT.result( 3 ) )
574 $ result( 3 ) = stemp
590 IF( iwork( k ).GT.zero )
THEN
595 stemp =
clange(
'M', n-k, 1,
596 $ afac( ( k-1 )*lda+k+1 ), lda, rwork )
602 stemp =
clange(
'M', n-k-1, 2,
603 $ afac( ( k-1 )*lda+k+2 ), lda, rwork )
610 stemp = stemp - const + thresh
611 IF( stemp.GT.result( 3 ) )
612 $ result( 3 ) = stemp
627 const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) )*
628 $ ( ( one + alpha ) / ( one - alpha ) )
630 IF( iuplo.EQ.1 )
THEN
639 IF( iwork( k ).LT.zero )
THEN
644 block( 1, 1 ) = afac( ( k-2 )*lda+k-1 )
645 block( 2, 1 ) = afac( ( k-2 )*lda+k )
646 block( 1, 2 ) = block( 2, 1 )
647 block( 2, 2 ) = afac( (k-1)*lda+k )
649 CALL
cgeevx(
'N',
'N',
'N',
'N', 2, block,
650 $ 2, work, cdummy, 1, cdummy, 1,
651 $ itemp, itemp2, rwork, stemp,
652 $ rwork( 3 ), rwork( 5 ), work( 3 ),
653 $ 4, rwork( 7 ), info )
655 lam_max = max( abs( work( 1 ) ),
657 lam_min = min( abs( work( 1 ) ),
660 stemp = lam_max / lam_min
664 stemp = abs( stemp ) - const + thresh
665 IF( stemp.GT.result( 4 ) )
666 $ result( 4 ) = stemp
685 IF( iwork( k ).LT.zero )
THEN
690 block( 1, 1 ) = afac( ( k-1 )*lda+k )
691 block( 2, 1 ) = afac( ( k-1 )*lda+k+1 )
692 block( 1, 2 ) = block( 2, 1 )
693 block( 2, 2 ) = afac( k*lda+k+1 )
695 CALL
cgeevx(
'N',
'N',
'N',
'N', 2, block,
696 $ 2, work, cdummy, 1, cdummy, 1,
697 $ itemp, itemp2, rwork, stemp,
698 $ rwork( 3 ), rwork( 5 ), work( 3 ),
699 $ 4, rwork( 7 ), info )
701 lam_max = max( abs( work( 1 ) ),
703 lam_min = min( abs( work( 1 ) ),
706 stemp = lam_max / lam_min
710 stemp = abs( stemp ) - const + thresh
711 IF( stemp.GT.result( 4 ) )
712 $ result( 4 ) = stemp
727 IF( result( k ).GE.thresh )
THEN
728 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
729 $ CALL
alahd( nout, path )
730 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
762 CALL
clarhs( matpath, xtype, uplo,
' ', n, n,
763 $ kl, ku, nrhs, a, lda, xact, lda,
764 $
b, lda, iseed, info )
765 CALL
clacpy(
'Full', n, nrhs,
b, lda, x, lda )
767 srnamt =
'CSYTRS_ROOK'
774 $ CALL
alaerh( path,
'CSYTRS_ROOK', info, 0,
775 $ uplo, n, n, -1, -1, nrhs, imat,
776 $ nfail, nerrs, nout )
778 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
782 CALL
csyt02( uplo, n, nrhs, a, lda, x, lda, work,
783 $ lda, rwork, result( 5 ) )
788 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
795 IF( result( k ).GE.thresh )
THEN
796 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
797 $ CALL
alahd( nout, path )
798 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
799 $ imat, k, result( k )
813 anorm =
clansy(
'1', uplo, n, a, lda, rwork )
814 srnamt =
'CSYCON_ROOK'
815 CALL
csycon_rook( uplo, n, afac, lda, iwork, anorm,
816 $ rcond, work, info )
821 $ CALL
alaerh( path,
'CSYCON_ROOK', info, 0,
822 $ uplo, n, n, -1, -1, -1, imat,
823 $ nfail, nerrs, nout )
827 result( 7 ) =
sget06( rcond, rcondc )
832 IF( result( 7 ).GE.thresh )
THEN
833 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
834 $ CALL
alahd( nout, path )
835 WRITE( nout, fmt = 9997 )uplo, n, imat, 7,
848 CALL
alasum( path, nout, nfail, nrun, nerrs )
850 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
851 $ i2,
', test ', i2,
', ratio =', g12.5 )
852 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
853 $ i2,
', test(', i2,
') =', g12.5 )
854 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
855 $
', test(', i2,
') =', g12.5 )