169 SUBROUTINE dchksy( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
170 $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
171 $ XACT, WORK, RWORK, IWORK, NOUT )
180 INTEGER nmax, nn, nnb, nns, nout
181 DOUBLE PRECISION thresh
185 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
186 DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ),
187 $ rwork( * ), work( * ), x( * ), xact( * )
193 DOUBLE PRECISION ZERO
194 PARAMETER ( ZERO = 0.0d+0 )
196 parameter( ntypes = 10 )
198 parameter( ntests = 9 )
201 LOGICAL TRFCON, ZEROT
202 CHARACTER DIST,
TYPE, UPLO, XTYPE
204 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
205 $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
206 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
207 DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC
211 INTEGER ISEED( 4 ), ISEEDY( 4 )
212 DOUBLE PRECISION RESULT( NTESTS )
215 DOUBLE PRECISION DGET06, DLANSY
216 EXTERNAL DGET06, DLANSY
233 COMMON / infoc / infot, nunit, ok, lerr
234 COMMON / srnamc / srnamt
237 DATA iseedy / 1988, 1989, 1990, 1991 /
238 DATA uplos /
'U',
'L' /
244 path( 1: 1 ) =
'Double precision'
250 iseed( i ) = iseedy( i )
256 $
CALL derrsy( path, nout )
278 DO 170 imat = 1, nimat
282 IF( .NOT.dotype( imat ) )
287 zerot = imat.GE.3 .AND. imat.LE.6
288 IF( zerot .AND. n.LT.imat-2 )
294 uplo = uplos( iuplo )
302 CALL dlatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
308 CALL dlatms( n, n, dist, iseed,
TYPE, rwork, mode,
309 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
315 CALL alaerh( path,
'DLATMS', info, 0, uplo, n, n, -1,
316 $ -1, -1, imat, nfail, nerrs, nout )
330 ELSE IF( imat.EQ.4 )
THEN
340 IF( iuplo.EQ.1 )
THEN
341 ioff = ( izero-1 )*lda
342 DO 20 i = 1, izero - 1
352 DO 40 i = 1, izero - 1
362 IF( iuplo.EQ.1 )
THEN
408 CALL dlacpy( uplo, n, n, a, lda, afac, lda )
415 lwork = max( 2, nb )*lda
417 CALL dsytrf( uplo, n, afac, lda, iwork, ainv, lwork,
426 IF( iwork( k ).LT.0 )
THEN
427 IF( iwork( k ).NE.-k )
THEN
431 ELSE IF( iwork( k ).NE.k )
THEN
440 $
CALL alaerh( path,
'DSYTRF', info, k, uplo, n, n,
441 $ -1, -1, nb, imat, nfail, nerrs, nout )
454 CALL dsyt01( uplo, n, a, lda, afac, lda, iwork, ainv,
455 $ lda, rwork, result( 1 ) )
464 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
465 CALL dlacpy( uplo, n, n, afac, lda, ainv, lda )
467 lwork = (n+nb+1)*(nb+3)
468 CALL dsytri2( uplo, n, ainv, lda, iwork, work,
474 $
CALL alaerh( path,
'DSYTRI2', info, -1, uplo, n,
475 $ n, -1, -1, -1, imat, nfail, nerrs,
481 CALL dpot03( uplo, n, a, lda, ainv, lda, work, lda,
482 $ rwork, rcondc, result( 2 ) )
490 IF( result( k ).GE.thresh )
THEN
491 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
492 $
CALL alahd( nout, path )
493 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
525 CALL dlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
526 $ nrhs, a, lda, xact, lda, b, lda,
528 CALL dlacpy(
'Full', n, nrhs, b, lda, x, lda )
531 CALL dsytrs( uplo, n, nrhs, afac, lda, iwork, x,
537 $
CALL alaerh( path,
'DSYTRS', info, 0, uplo, n,
538 $ n, -1, -1, nrhs, imat, nfail,
541 CALL dlacpy(
'Full', n, nrhs, b, lda, work, lda )
545 CALL dpot02( uplo, n, nrhs, a, lda, x, lda, work,
546 $ lda, rwork, result( 3 ) )
556 CALL dlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
557 $ nrhs, a, lda, xact, lda, b, lda,
559 CALL dlacpy(
'Full', n, nrhs, b, lda, x, lda )
562 CALL dsytrs2( uplo, n, nrhs, afac, lda, iwork, x,
568 $
CALL alaerh( path,
'DSYTRS2', info, 0, uplo, n,
569 $ n, -1, -1, nrhs, imat, nfail,
572 CALL dlacpy(
'Full', n, nrhs, b, lda, work, lda )
576 CALL dpot02( uplo, n, nrhs, a, lda, x, lda, work,
577 $ lda, rwork, result( 4 ) )
582 CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
589 CALL dsyrfs( uplo, n, nrhs, a, lda, afac, lda,
590 $ iwork, b, lda, x, lda, rwork,
591 $ rwork( nrhs+1 ), work, iwork( n+1 ),
597 $
CALL alaerh( path,
'DSYRFS', info, 0, uplo, n,
598 $ n, -1, -1, nrhs, imat, nfail,
601 CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
603 CALL dpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
604 $ xact, lda, rwork, rwork( nrhs+1 ),
611 IF( result( k ).GE.thresh )
THEN
612 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
613 $
CALL alahd( nout, path )
614 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
615 $ imat, k, result( k )
629 anorm = dlansy(
'1', uplo, n, a, lda, rwork )
631 CALL dsycon( uplo, n, afac, lda, iwork, anorm, rcond,
632 $ work, iwork( n+1 ), info )
637 $
CALL alaerh( path,
'DSYCON', info, 0, uplo, n, n,
638 $ -1, -1, -1, imat, nfail, nerrs, nout )
642 result( 9 ) = dget06( rcond, rcondc )
647 IF( result( 9 ).GE.thresh )
THEN
648 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
649 $
CALL alahd( nout, path )
650 WRITE( nout, fmt = 9997 )uplo, n, imat, 9,
663 CALL alasum( path, nout, nfail, nrun, nerrs )
665 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
666 $ i2,
', test ', i2,
', ratio =', g12.5 )
667 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
668 $ i2,
', test(', i2,
') =', g12.5 )
669 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
670 $
', test(', i2,
') =', g12.5 )