239 SUBROUTINE sdrvrfp( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL,
240 + thresh, a, asav, afac, ainv, b,
241 + bsav, xact, x, arf, arfinv,
242 + s_work_slatms, s_work_spot01, s_temp_spot02,
243 + s_temp_spot03, s_work_slansy,
244 + s_work_spot02, s_work_spot03 )
252 INTEGER NN, NNS, NNT, NOUT
256 INTEGER NVAL( nn ), NSVAL( nns ), NTVAL( nnt )
267 REAL S_WORK_SLATMS( * )
268 REAL S_WORK_SPOT01( * )
269 REAL S_TEMP_SPOT02( * )
270 REAL S_TEMP_SPOT03( * )
271 REAL S_WORK_SLANSY( * )
272 REAL S_WORK_SPOT02( * )
273 REAL S_WORK_SPOT03( * )
280 parameter ( one = 1.0e+0, zero = 0.0e+0 )
282 parameter ( ntests = 4 )
286 INTEGER I, INFO, IUPLO, LDA, LDB, IMAT, NERRS, NFAIL,
287 + nrhs, nrun, izero, ioff, k, nt, n, iform, iin,
289 CHARACTER DIST, CTYPE, UPLO, CFORM
291 REAL ANORM, AINVNM, CNDNUM, RCONDC
294 CHARACTER UPLOS( 2 ), FORMS( 2 )
295 INTEGER ISEED( 4 ), ISEEDY( 4 )
296 REAL RESULT( ntests )
311 COMMON / srnamc / srnamt
314 DATA iseedy / 1988, 1989, 1990, 1991 /
315 DATA uplos /
'U',
'L' /
316 DATA forms /
'N',
'T' /
326 iseed( i ) = iseedy( i )
345 IF( n.EQ.0 .AND. iit.GE.1 )
GO TO 120
349 IF( imat.EQ.4 .AND. n.LE.1 )
GO TO 120
350 IF( imat.EQ.5 .AND. n.LE.2 )
GO TO 120
355 uplo = uplos( iuplo )
360 cform = forms( iform )
365 CALL slatb4(
'SPO', imat, n, n, ctype, kl, ku,
366 + anorm, mode, cndnum, dist )
369 CALL slatms( n, n, dist, iseed, ctype,
371 + mode, cndnum, anorm, kl, ku, uplo, a,
372 + lda, s_work_slatms, info )
377 CALL alaerh(
'SPF',
'SLATMS', info, 0, uplo, n,
378 + n, -1, -1, -1, iit, nfail, nerrs,
386 zerot = imat.GE.3 .AND. imat.LE.5
390 ELSE IF( iit.EQ.4 )
THEN
395 ioff = ( izero-1 )*lda
399 IF( iuplo.EQ.1 )
THEN
400 DO 20 i = 1, izero - 1
410 DO 40 i = 1, izero - 1
425 CALL slacpy( uplo, n, n, a, lda, asav, lda )
435 anorm = slansy(
'1', uplo, n, a, lda,
440 CALL spotrf( uplo, n, a, lda, info )
444 CALL spotri( uplo, n, a, lda, info )
450 ainvnm = slansy(
'1', uplo, n, a, lda,
452 rcondc = ( one / anorm ) / ainvnm
456 CALL slacpy( uplo, n, n, asav, lda, a, lda )
464 CALL slarhs(
'SPO',
'N', uplo,
' ', n, n, kl, ku,
465 + nrhs, a, lda, xact, lda, b, lda,
467 CALL slacpy(
'Full', n, nrhs, b, lda, bsav, lda )
472 CALL slacpy( uplo, n, n, a, lda, afac, lda )
473 CALL slacpy(
'Full', n, nrhs, b, ldb, x, ldb )
476 CALL strttf( cform, uplo, n, afac, lda, arf, info )
478 CALL spftrf( cform, uplo, n, arf, info )
482 IF( info.NE.izero )
THEN
488 CALL alaerh(
'SPF',
'SPFSV ', info, izero,
489 + uplo, n, n, -1, -1, nrhs, iit,
490 + nfail, nerrs, nout )
501 CALL spftrs( cform, uplo, n, nrhs, arf, x, ldb,
505 CALL stfttr( cform, uplo, n, arf, afac, lda, info )
510 CALL slacpy( uplo, n, n, afac, lda, asav, lda )
511 CALL spot01( uplo, n, a, lda, afac, lda,
512 + s_work_spot01, result( 1 ) )
513 CALL slacpy( uplo, n, n, asav, lda, afac, lda )
517 IF(mod(n,2).EQ.0)
THEN
518 CALL slacpy(
'A', n+1, n/2, arf, n+1, arfinv,
521 CALL slacpy(
'A', n, (n+1)/2, arf, n, arfinv,
526 CALL spftri( cform, uplo, n, arfinv , info )
529 CALL stfttr( cform, uplo, n, arfinv, ainv, lda,
535 +
CALL alaerh(
'SPO',
'SPFTRI', info, 0, uplo, n,
536 + n, -1, -1, -1, imat, nfail, nerrs,
539 CALL spot03( uplo, n, a, lda, ainv, lda,
540 + s_temp_spot03, lda, s_work_spot03,
541 + rcondc, result( 2 ) )
545 CALL slacpy(
'Full', n, nrhs, b, lda,
546 + s_temp_spot02, lda )
547 CALL spot02( uplo, n, nrhs, a, lda, x, lda,
548 + s_temp_spot02, lda, s_work_spot02,
553 CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
561 IF( result( k ).GE.thresh )
THEN
562 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
563 +
CALL aladhd( nout,
'SPF' )
564 WRITE( nout, fmt = 9999 )
'SPFSV ', uplo,
565 + n, iit, k, result( k )
578 CALL alasvm(
'SPF', nout, nfail, nrun, nerrs )
580 9999
FORMAT( 1x, a6,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
581 +
', test(', i1,
')=', g12.5 )
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 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
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sdrvrfp(NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, A, ASAV, AFAC, AINV, B, BSAV, XACT, X, ARF, ARFINV, S_WORK_SLATMS, S_WORK_SPOT01, S_TEMP_SPOT02, S_TEMP_SPOT03, S_WORK_SLANSY, S_WORK_SPOT02, S_WORK_SPOT03)
SDRVRFP
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 spftrf(TRANSR, UPLO, N, A, INFO)
SPFTRF
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
subroutine spot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
SPOT03
subroutine strttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
STRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine spftri(TRANSR, UPLO, N, A, INFO)
SPFTRI
subroutine stfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
STFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
subroutine spot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SPOT02
subroutine spftrs(TRANSR, UPLO, N, NRHS, A, B, LDB, INFO)
SPFTRS
subroutine spotri(UPLO, N, A, LDA, INFO)
SPOTRI