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( 1
x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
726 $
', test(', i1,
')=', g12.5 )
727 9998
FORMAT( 1
x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N=', i5,
728 $
', type ', i1,
', test(', i1,
')=', g12.5 )
729 9997
FORMAT( 1
x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N=', i5,
730 $
', EQUED=''', a1,
''', type ', i1,
', test(', i1,
') =',
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...
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.
LOGICAL function lsame(CA, CB)
LSAME
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 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 sdrvpo(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
SDRVPO
subroutine spot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
SPOT05
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
subroutine spot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SPOT02
subroutine spotri(UPLO, N, A, LDA, INFO)
SPOTRI
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
REAL function sget06(RCOND, RCONDC)
SGET06
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine sebchvxx(THRESH, PATH)
SEBCHVXX
subroutine slaqsy(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
SLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
subroutine spot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
SPOT01
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
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 ...
subroutine spoequ(N, A, LDA, S, SCOND, AMAX, INFO)
SPOEQU
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine spotrf(UPLO, N, A, LDA, INFO)
SPOTRF
subroutine serrvx(PATH, NUNIT)
SERRVX
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4