171 $ thresh, tsterr, nmax, a, afac, ainv,
b, x,
172 $ xact, work, rwork, iwork, nout )
181 INTEGER nmax, nn, nnb, nns, nout
182 DOUBLE PRECISION thresh
186 INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
187 DOUBLE PRECISION a( * ), afac( * ), ainv( * ),
b( * ),
188 $ rwork( * ), work( * ), x( * ), xact( * )
194 DOUBLE PRECISION zero, one
195 parameter( zero = 0.0d+0, one = 1.0d+0 )
196 DOUBLE PRECISION eight, sevten
197 parameter( eight = 8.0d+0, sevten = 17.0d+0 )
199 parameter( ntypes = 10 )
201 parameter( ntests = 7 )
204 LOGICAL trfcon, zerot
205 CHARACTER dist, type, uplo, xtype
206 CHARACTER*3 path, matpath
207 INTEGER i, i1, i2, imat, in, inb, info, ioff, irhs,
208 $ itemp, iuplo, izero,
j, k, kl, ku, lda, lwork,
209 $ mode, n, nb, nerrs, nfail, nimat, nrhs, nrun,
211 DOUBLE PRECISION alpha, anorm, cndnum, const, dtemp, lam_max,
212 $ lam_min, rcond, rcondc
216 INTEGER idummy( 1 ), iseed( 4 ), iseedy( 4 )
217 DOUBLE PRECISION ddummy( 1 ), result( ntests )
230 INTRINSIC abs, max, min, sqrt
238 COMMON / infoc / infot, nunit, ok, lerr
239 COMMON / srnamc / srnamt
242 DATA iseedy / 1988, 1989, 1990, 1991 /
243 DATA uplos /
'U',
'L' /
249 alpha = ( one+sqrt( sevten ) ) / eight
253 path( 1: 1 ) =
'Double precision'
258 matpath( 1: 1 ) =
'Double precision'
259 matpath( 2: 3 ) =
'SY'
265 iseed( i ) = iseedy( i )
271 $ CALL
derrsy( path, nout )
293 DO 260 imat = 1, nimat
297 IF( .NOT.dotype( imat ) )
302 zerot = imat.GE.3 .AND. imat.LE.6
303 IF( zerot .AND. n.LT.imat-2 )
309 uplo = uplos( iuplo )
316 CALL
dlatb4( matpath, imat, n, n, type, kl, ku, anorm,
317 $ mode, cndnum, dist )
322 CALL
dlatms( n, n, dist, iseed, type, rwork, mode,
323 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
329 CALL
alaerh( path,
'DLATMS', info, 0, uplo, n, n, -1,
330 $ -1, -1, imat, nfail, nerrs, nout )
344 ELSE IF( imat.EQ.4 )
THEN
354 IF( iuplo.EQ.1 )
THEN
355 ioff = ( izero-1 )*lda
356 DO 20 i = 1, izero - 1
366 DO 40 i = 1, izero - 1
376 IF( iuplo.EQ.1 )
THEN
423 CALL
dlacpy( uplo, n, n, a, lda, afac, lda )
430 lwork = max( 2, nb )*lda
431 srnamt =
'DSYTRF_ROOK'
441 IF( iwork( k ).LT.0 )
THEN
442 IF( iwork( k ).NE.-k )
THEN
446 ELSE IF( iwork( k ).NE.k )
THEN
455 $ CALL
alaerh( path,
'DSYTRF_ROOK', info, k,
456 $ uplo, n, n, -1, -1, nb, imat,
457 $ nfail, nerrs, nout )
470 CALL
dsyt01_rook( uplo, n, a, lda, afac, lda, iwork,
471 $ ainv, lda, rwork, result( 1 ) )
480 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
481 CALL
dlacpy( uplo, n, n, afac, lda, ainv, lda )
482 srnamt =
'DSYTRI_ROOK'
489 $ CALL
alaerh( path,
'DSYTRI_ROOK', info, -1,
490 $ uplo, n, n, -1, -1, -1, imat,
491 $ nfail, nerrs, nout )
496 CALL
dpot03( uplo, n, a, lda, ainv, lda, work, lda,
497 $ rwork, rcondc, result( 2 ) )
505 IF( result( k ).GE.thresh )
THEN
506 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
507 $ CALL
alahd( nout, path )
508 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
521 const = one / ( one-alpha )
523 IF( iuplo.EQ.1 )
THEN
532 IF( iwork( k ).GT.zero )
THEN
537 dtemp =
dlange(
'M', k-1, 1,
538 $ afac( ( k-1 )*lda+1 ), lda, rwork )
544 dtemp =
dlange(
'M', k-2, 2,
545 $ afac( ( k-2 )*lda+1 ), lda, rwork )
552 dtemp = dtemp - const + thresh
553 IF( dtemp.GT.result( 3 ) )
554 $ result( 3 ) = dtemp
570 IF( iwork( k ).GT.zero )
THEN
575 dtemp =
dlange(
'M', n-k, 1,
576 $ afac( ( k-1 )*lda+k+1 ), lda, rwork )
582 dtemp =
dlange(
'M', n-k-1, 2,
583 $ afac( ( k-1 )*lda+k+2 ), lda, rwork )
590 dtemp = dtemp - const + thresh
591 IF( dtemp.GT.result( 3 ) )
592 $ result( 3 ) = dtemp
607 const = ( one+alpha ) / ( one-alpha )
608 CALL
dlacpy( uplo, n, n, afac, lda, ainv, lda )
610 IF( iuplo.EQ.1 )
THEN
619 IF( iwork( k ).LT.zero )
THEN
624 CALL
dsyevx(
'N',
'A', uplo, 2,
625 $ ainv( ( k-2 )*lda+k-1 ), lda, dtemp,
626 $ dtemp, itemp, itemp, zero, itemp,
627 $ rwork, ddummy, 1, work, 16,
628 $ iwork( n+1 ), idummy, info )
630 lam_max = max( abs( rwork( 1 ) ),
631 $ abs( rwork( 2 ) ) )
632 lam_min = min( abs( rwork( 1 ) ),
633 $ abs( rwork( 2 ) ) )
635 dtemp = lam_max / lam_min
639 dtemp = abs( dtemp ) - const + thresh
640 IF( dtemp.GT.result( 4 ) )
641 $ result( 4 ) = dtemp
660 IF( iwork( k ).LT.zero )
THEN
665 CALL
dsyevx(
'N',
'A', uplo, 2,
666 $ ainv( ( k-1 )*lda+k ), lda, dtemp,
667 $ dtemp, itemp, itemp, zero, itemp,
668 $ rwork, ddummy, 1, work, 16,
669 $ iwork( n+1 ), idummy, info )
671 lam_max = max( abs( rwork( 1 ) ),
672 $ abs( rwork( 2 ) ) )
673 lam_min = min( abs( rwork( 1 ) ),
674 $ abs( rwork( 2 ) ) )
676 dtemp = lam_max / lam_min
680 dtemp = abs( dtemp ) - const + thresh
681 IF( dtemp.GT.result( 4 ) )
682 $ result( 4 ) = dtemp
697 IF( result( k ).GE.thresh )
THEN
698 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
699 $ CALL
alahd( nout, path )
700 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
732 CALL
dlarhs( matpath, xtype, uplo,
' ', n, n,
733 $ kl, ku, nrhs, a, lda, xact, lda,
734 $
b, lda, iseed, info )
735 CALL
dlacpy(
'Full', n, nrhs,
b, lda, x, lda )
737 srnamt =
'DSYTRS_ROOK'
744 $ CALL
alaerh( path,
'DSYTRS_ROOK', info, 0,
745 $ uplo, n, n, -1, -1, nrhs, imat,
746 $ nfail, nerrs, nout )
748 CALL
dlacpy(
'Full', n, nrhs,
b, lda, work, lda )
752 CALL
dpot02( uplo, n, nrhs, a, lda, x, lda, work,
753 $ lda, rwork, result( 5 ) )
758 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
765 IF( result( k ).GE.thresh )
THEN
766 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
767 $ CALL
alahd( nout, path )
768 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
769 $ imat, k, result( k )
783 anorm =
dlansy(
'1', uplo, n, a, lda, rwork )
784 srnamt =
'DSYCON_ROOK'
785 CALL
dsycon_rook( uplo, n, afac, lda, iwork, anorm,
786 $ rcond, work, iwork( n+1 ), info )
791 $ CALL
alaerh( path,
'DSYCON_ROOK', info, 0,
792 $ uplo, n, n, -1, -1, -1, imat,
793 $ nfail, nerrs, nout )
797 result( 7 ) =
dget06( rcond, rcondc )
802 IF( result( 7 ).GE.thresh )
THEN
803 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
804 $ CALL
alahd( nout, path )
805 WRITE( nout, fmt = 9997 )uplo, n, imat, 7,
818 CALL
alasum( path, nout, nfail, nrun, nerrs )
820 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
821 $ i2,
', test ', i2,
', ratio =', g12.5 )
822 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
823 $ i2,
', test(', i2,
') =', g12.5 )
824 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
825 $
', test(', i2,
') =', g12.5 )