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 )