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 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 alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
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 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 spftrs(TRANSR, UPLO, N, NRHS, A, B, LDB, INFO)
SPFTRS
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
subroutine spftrf(TRANSR, UPLO, N, A, INFO)
SPFTRF
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 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 spot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
SPOT03
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine spftri(TRANSR, UPLO, N, A, INFO)
SPFTRI
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.
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 spotrf(UPLO, N, A, LDA, INFO)
SPOTRF
Intel Corp All rights reserved Redistribution and use in source and binary forms
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4