166 SUBROUTINE sdrvpo( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
167 $ a, afac, asav, b, bsav, x, xact, s, work,
168 $ rwork, iwork, nout )
177 INTEGER nmax, nn, nout, nrhs
182 INTEGER iwork( * ), nval( * )
183 REAL a( * ), afac( * ), asav( * ), b( * ),
184 $ bsav( * ), rwork( * ), s( * ), work( * ),
192 parameter ( one = 1.0e+0, zero = 0.0e+0 )
194 parameter ( ntypes = 9 )
196 parameter ( ntests = 6 )
199 LOGICAL equil, nofact, prefac, zerot
200 CHARACTER dist, equed, fact,
TYPE, uplo, xtype
202 INTEGER i, iequed, ifact, imat, in, info, ioff, iuplo,
203 $ izero, k, k1, kl, ku, lda, mode, n, nb, nbmin,
204 $ nerrs, nfact, nfail, nimat, nrun, nt,
206 REAL ainvnm, amax, anorm, cndnum, rcond, rcondc,
207 $ roldc, scond, rpvgrw_svxx
210 CHARACTER equeds( 2 ), facts( 3 ), uplos( 2 )
211 INTEGER iseed( 4 ), iseedy( 4 )
212 REAL result( ntests ), berr( nrhs ),
213 $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
235 COMMON / infoc / infot, nunit, ok, lerr
236 COMMON / srnamc / srnamt
239 DATA iseedy / 1988, 1989, 1990, 1991 /
240 DATA uplos /
'U',
'L' /
241 DATA facts /
'F',
'N',
'E' /
242 DATA equeds /
'N',
'Y' /
248 path( 1: 1 ) =
'Single precision'
254 iseed( i ) = iseedy( i )
260 $
CALL serrvx( path, nout )
280 DO 120 imat = 1, nimat
284 IF( .NOT.dotype( imat ) )
289 zerot = imat.GE.3 .AND. imat.LE.5
290 IF( zerot .AND. n.LT.imat-2 )
296 uplo = uplos( iuplo )
301 CALL slatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
305 CALL slatms( n, n, dist, iseed,
TYPE, rwork, mode,
306 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
312 CALL alaerh( path,
'SLATMS', info, 0, uplo, n, n, -1,
313 $ -1, -1, imat, nfail, nerrs, nout )
323 ELSE IF( imat.EQ.4 )
THEN
328 ioff = ( izero-1 )*lda
332 IF( iuplo.EQ.1 )
THEN
333 DO 20 i = 1, izero - 1
343 DO 40 i = 1, izero - 1
358 CALL slacpy( uplo, n, n, a, lda, asav, lda )
361 equed = equeds( iequed )
362 IF( iequed.EQ.1 )
THEN
368 DO 90 ifact = 1, nfact
369 fact = facts( ifact )
370 prefac =
lsame( fact,
'F' )
371 nofact =
lsame( fact,
'N' )
372 equil =
lsame( fact,
'E' )
379 ELSE IF( .NOT.
lsame( fact,
'N' ) )
THEN
386 CALL slacpy( uplo, n, n, asav, lda, afac, lda )
387 IF( equil .OR. iequed.GT.1 )
THEN
392 CALL spoequ( n, afac, lda, s, scond, amax,
394 IF( info.EQ.0 .AND. n.GT.0 )
THEN
400 CALL slaqsy( uplo, n, afac, lda, s, scond,
413 anorm =
slansy(
'1', uplo, n, afac, lda, rwork )
417 CALL spotrf( uplo, n, afac, lda, info )
421 CALL slacpy( uplo, n, n, afac, lda, a, lda )
422 CALL spotri( uplo, n, a, lda, info )
426 ainvnm =
slansy(
'1', uplo, n, a, lda, rwork )
427 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
430 rcondc = ( one / anorm ) / ainvnm
436 CALL slacpy( uplo, n, n, asav, lda, a, lda )
441 CALL slarhs( path, xtype, uplo,
' ', n, n, kl, ku,
442 $ nrhs, a, lda, xact, lda, b, lda,
445 CALL slacpy(
'Full', n, nrhs, b, lda, bsav, lda )
454 CALL slacpy( uplo, n, n, a, lda, afac, lda )
455 CALL slacpy(
'Full', n, nrhs, b, lda, x, lda )
458 CALL sposv( uplo, n, nrhs, afac, lda, x, lda,
463 IF( info.NE.izero )
THEN
464 CALL alaerh( path,
'SPOSV ', info, izero,
465 $ uplo, n, n, -1, -1, nrhs, imat,
466 $ nfail, nerrs, nout )
468 ELSE IF( info.NE.0 )
THEN
475 CALL spot01( uplo, n, a, lda, afac, lda, rwork,
480 CALL slacpy(
'Full', n, nrhs, b, lda, work,
482 CALL spot02( uplo, n, nrhs, a, lda, x, lda,
483 $ work, lda, rwork, result( 2 ) )
487 CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
495 IF( result( k ).GE.thresh )
THEN
496 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
497 $
CALL aladhd( nout, path )
498 WRITE( nout, fmt = 9999 )
'SPOSV ', uplo,
499 $ n, imat, k, result( k )
510 $
CALL slaset( uplo, n, n, zero, zero, afac, lda )
511 CALL slaset(
'Full', n, nrhs, zero, zero, x, lda )
512 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
517 CALL slaqsy( uplo, n, a, lda, s, scond, amax,
525 CALL sposvx( fact, uplo, n, nrhs, a, lda, afac,
526 $ lda, equed, s, b, lda, x, lda, rcond,
527 $ rwork, rwork( nrhs+1 ), work, iwork,
532 IF( info.NE.izero )
THEN
533 CALL alaerh( path,
'SPOSVX', info, izero,
534 $ fact // uplo, n, n, -1, -1, nrhs,
535 $ imat, nfail, nerrs, nout )
540 IF( .NOT.prefac )
THEN
545 CALL spot01( uplo, n, a, lda, afac, lda,
546 $ rwork( 2*nrhs+1 ), result( 1 ) )
554 CALL slacpy(
'Full', n, nrhs, bsav, lda, work,
556 CALL spot02( uplo, n, nrhs, asav, lda, x, lda,
557 $ work, lda, rwork( 2*nrhs+1 ),
562 IF( nofact .OR. ( prefac .AND.
lsame( equed,
564 CALL sget04( n, nrhs, x, lda, xact, lda,
565 $ rcondc, result( 3 ) )
567 CALL sget04( n, nrhs, x, lda, xact, lda,
568 $ roldc, result( 3 ) )
574 CALL spot05( uplo, n, nrhs, asav, lda, b, lda,
575 $ x, lda, xact, lda, rwork,
576 $ rwork( nrhs+1 ), result( 4 ) )
584 result( 6 ) =
sget06( rcond, rcondc )
590 IF( result( k ).GE.thresh )
THEN
591 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
592 $
CALL aladhd( nout, path )
594 WRITE( nout, fmt = 9997 )
'SPOSVX', fact,
595 $ uplo, n, equed, imat, k, result( k )
597 WRITE( nout, fmt = 9998 )
'SPOSVX', fact,
598 $ uplo, n, imat, k, result( k )
609 CALL slacpy(
'Full', n, n, asav, lda, a, lda )
610 CALL slacpy(
'Full', n, nrhs, bsav, lda, b, lda )
613 $
CALL slaset( uplo, n, n, zero, zero, afac, lda )
614 CALL slaset(
'Full', n, nrhs, zero, zero, x, lda )
615 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
620 CALL slaqsy( uplo, n, a, lda, s, scond, amax,
629 CALL sposvxx( fact, uplo, n, nrhs, a, lda, afac,
630 $ lda, equed, s, b, lda, x,
631 $ lda, rcond, rpvgrw_svxx, berr, n_err_bnds,
632 $ errbnds_n, errbnds_c, 0, zero, work,
637 IF( info.EQ.n+1 )
GOTO 90
638 IF( info.NE.izero )
THEN
639 CALL alaerh( path,
'SPOSVXX', info, izero,
640 $ fact // uplo, n, n, -1, -1, nrhs,
641 $ imat, nfail, nerrs, nout )
646 IF( .NOT.prefac )
THEN
651 CALL spot01( uplo, n, a, lda, afac, lda,
652 $ rwork( 2*nrhs+1 ), result( 1 ) )
660 CALL slacpy(
'Full', n, nrhs, bsav, lda, work,
662 CALL spot02( uplo, n, nrhs, asav, lda, x, lda,
663 $ work, lda, rwork( 2*nrhs+1 ),
668 IF( nofact .OR. ( prefac .AND.
lsame( equed,
670 CALL sget04( n, nrhs, x, lda, xact, lda,
671 $ rcondc, result( 3 ) )
673 CALL sget04( n, nrhs, x, lda, xact, lda,
674 $ roldc, result( 3 ) )
680 CALL spot05( uplo, n, nrhs, asav, lda, b, lda,
681 $ x, lda, xact, lda, rwork,
682 $ rwork( nrhs+1 ), result( 4 ) )
690 result( 6 ) =
sget06( rcond, rcondc )
696 IF( result( k ).GE.thresh )
THEN
697 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
698 $
CALL aladhd( nout, path )
700 WRITE( nout, fmt = 9997 )
'SPOSVXX', fact,
701 $ uplo, n, equed, imat, k, result( k )
703 WRITE( nout, fmt = 9998 )
'SPOSVXX', fact,
704 $ uplo, n, imat, k, result( k )
718 CALL alasvm( path, nout, nfail, nrun, nerrs )
725 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
726 $
', test(', i1,
')=', g12.5 )
727 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N=', i5,
728 $
', type ', i1,
', test(', i1,
')=', g12.5 )
729 9997
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N=', i5,
730 $
', EQUED=''', a1,
''', type ', i1,
', test(', i1,
') =',
subroutine sposvxx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
SPOSVXX computes the solution to system of linear equations A * X = B for PO matrices ...
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
subroutine sebchvxx(THRESH, PATH)
SEBCHVXX
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
subroutine spot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
SPOT01
real function sget06(RCOND, RCONDC)
SGET06
subroutine spot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
SPOT05
subroutine sdrvpo(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
SDRVPO
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
subroutine spotrf(UPLO, N, A, LDA, INFO)
SPOTRF
subroutine slaqsy(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
SLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
subroutine sposv(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
SPOSV computes the solution to system of linear equations A * X = B for PO matrices ...
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine spoequ(N, A, LDA, S, SCOND, AMAX, INFO)
SPOEQU
logical function lsame(CA, CB)
LSAME
subroutine serrvx(PATH, NUNIT)
SERRVX
subroutine spot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SPOT02
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine spotri(UPLO, N, A, LDA, INFO)
SPOTRI
subroutine sposvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
SPOSVX computes the solution to system of linear equations A * X = B for PO matrices ...
real function slansy(NORM, UPLO, N, A, LDA, WORK)
SLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.