149 SUBROUTINE sdrvsy( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
150 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
159 INTEGER NMAX, NN, NOUT, NRHS
164 INTEGER IWORK( * ), NVAL( * )
165 REAL A( * ), AFAC( * ), AINV( * ), B( * ),
166 $ rwork( * ), work( * ), x( * ), xact( * )
173 PARAMETER ( ONE = 1.0e+0, zero = 0.0e+0 )
174 INTEGER NTYPES, NTESTS
175 parameter( ntypes = 10, ntests = 6 )
177 parameter( nfact = 2 )
181 CHARACTER DIST, FACT,
TYPE, UPLO, XTYPE
183 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
184 $ izero, j, k, k1, kl, ku, lda, lwork, mode, n,
185 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
186 REAL AINVNM, ANORM, CNDNUM, RCOND, RCONDC
189 CHARACTER FACTS( NFACT ), UPLOS( 2 )
190 INTEGER ISEED( 4 ), ISEEDY( 4 )
191 REAL RESULT( NTESTS )
195 EXTERNAL SGET06, SLANSY
208 COMMON / infoc / infot, nunit, ok, lerr
209 COMMON / srnamc / srnamt
215 DATA iseedy / 1988, 1989, 1990, 1991 /
216 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
222 path( 1: 1 ) =
'Single precision'
228 iseed( i ) = iseedy( i )
230 lwork = max( 2*nmax, nmax*nrhs )
235 $
CALL serrvx( path, nout )
255 DO 170 imat = 1, nimat
259 IF( .NOT.dotype( imat ) )
264 zerot = imat.GE.3 .AND. imat.LE.6
265 IF( zerot .AND. n.LT.imat-2 )
271 uplo = uplos( iuplo )
276 CALL slatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
280 CALL slatms( n, n, dist, iseed,
TYPE, rwork, mode,
281 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
287 CALL alaerh( path,
'SLATMS', info, 0, uplo, n, n, -1,
288 $ -1, -1, imat, nfail, nerrs, nout )
298 ELSE IF( imat.EQ.4 )
THEN
308 IF( iuplo.EQ.1 )
THEN
309 ioff = ( izero-1 )*lda
310 DO 20 i = 1, izero - 1
320 DO 40 i = 1, izero - 1
331 IF( iuplo.EQ.1 )
THEN
359 DO 150 ifact = 1, nfact
363 fact = facts( ifact )
373 ELSE IF( ifact.EQ.1 )
THEN
377 anorm = slansy(
'1', uplo, n, a, lda, rwork )
381 CALL slacpy( uplo, n, n, a, lda, afac, lda )
382 CALL ssytrf( uplo, n, afac, lda, iwork, work,
387 CALL slacpy( uplo, n, n, afac, lda, ainv, lda )
388 lwork = (n+nb+1)*(nb+3)
389 CALL ssytri2( uplo, n, ainv, lda, iwork, work,
391 ainvnm = slansy(
'1', uplo, n, ainv, lda, rwork )
395 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
398 rcondc = ( one / anorm ) / ainvnm
405 CALL slarhs( path, xtype, uplo,
' ', n, n, kl, ku,
406 $ nrhs, a, lda, xact, lda, b, lda, iseed,
412 IF( ifact.EQ.2 )
THEN
413 CALL slacpy( uplo, n, n, a, lda, afac, lda )
414 CALL slacpy(
'Full', n, nrhs, b, lda, x, lda )
419 CALL ssysv( uplo, n, nrhs, afac, lda, iwork, x,
420 $ lda, work, lwork, info )
428 IF( iwork( k ).LT.0 )
THEN
429 IF( iwork( k ).NE.-k )
THEN
433 ELSE IF( iwork( k ).NE.k )
THEN
442 CALL alaerh( path,
'SSYSV ', info, k, uplo, n,
443 $ n, -1, -1, nrhs, imat, nfail,
446 ELSE IF( info.NE.0 )
THEN
453 CALL ssyt01( uplo, n, a, lda, afac, lda, iwork,
454 $ ainv, lda, rwork, result( 1 ) )
458 CALL slacpy(
'Full', n, nrhs, b, lda, work, lda )
459 CALL spot02( uplo, n, nrhs, a, lda, x, lda, work,
460 $ lda, rwork, result( 2 ) )
464 CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
472 IF( result( k ).GE.thresh )
THEN
473 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
474 $
CALL aladhd( nout, path )
475 WRITE( nout, fmt = 9999 )
'SSYSV ', uplo, n,
476 $ imat, k, result( k )
487 $
CALL slaset( uplo, n, n, zero, zero, afac, lda )
488 CALL slaset(
'Full', n, nrhs, zero, zero, x, lda )
494 CALL ssysvx( fact, uplo, n, nrhs, a, lda, afac, lda,
495 $ iwork, b, lda, x, lda, rcond, rwork,
496 $ rwork( nrhs+1 ), work, lwork,
497 $ iwork( n+1 ), info )
505 IF( iwork( k ).LT.0 )
THEN
506 IF( iwork( k ).NE.-k )
THEN
510 ELSE IF( iwork( k ).NE.k )
THEN
519 CALL alaerh( path,
'SSYSVX', info, k, fact // uplo,
520 $ n, n, -1, -1, nrhs, imat, nfail,
526 IF( ifact.GE.2 )
THEN
531 CALL ssyt01( uplo, n, a, lda, afac, lda, iwork,
532 $ ainv, lda, rwork( 2*nrhs+1 ),
541 CALL slacpy(
'Full', n, nrhs, b, lda, work, lda )
542 CALL spot02( uplo, n, nrhs, a, lda, x, lda, work,
543 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
547 CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
552 CALL spot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
553 $ xact, lda, rwork, rwork( nrhs+1 ),
562 result( 6 ) = sget06( rcond, rcondc )
568 IF( result( k ).GE.thresh )
THEN
569 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
570 $
CALL aladhd( nout, path )
571 WRITE( nout, fmt = 9998 )
'SSYSVX', fact, uplo,
572 $ n, imat, k, result( k )
586 CALL alasvm( path, nout, nfail, nrun, nerrs )
588 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
589 $
', test ', i2,
', ratio =', g12.5 )
590 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
591 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )