174 INTEGER NMAX, NN, NOUT, NRHS
179 INTEGER IWORK( * ), NVAL( * )
180 REAL A( * ), AFAC( * ), ASAV( * ), B( * ),
181 $ BSAV( * ), RWORK( * ), S( * ), WORK( * ),
189 parameter( one = 1.0e+0, zero = 0.0e+0 )
190 INTEGER NTYPES, NTESTS
191 parameter( ntypes = 8, ntests = 6 )
196 LOGICAL EQUIL, NOFACT, PREFAC, ZEROT
197 CHARACTER DIST, EQUED, FACT, PACKIT,
TYPE, UPLO, XTYPE
199 INTEGER I, I1, I2, IEQUED, IFACT, IKD, IMAT, IN, INFO,
200 $ IOFF, IUPLO, IW, IZERO, K, K1, KD, KL, KOFF,
201 $ KU, LDA, LDAB, MODE, N, NB, NBMIN, NERRS,
202 $ NFACT, NFAIL, NIMAT, NKD, NRUN, NT
203 REAL AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
207 CHARACTER EQUEDS( 2 ), FACTS( 3 )
208 INTEGER ISEED( 4 ), ISEEDY( 4 ), KDVAL( NBW )
209 REAL RESULT( NTESTS )
213 REAL SGET06, SLANGE, SLANSB
231 COMMON / infoc / infot, nunit, ok, lerr
232 COMMON / srnamc / srnamt
235 DATA iseedy / 1988, 1989, 1990, 1991 /
236 DATA facts /
'F',
'N',
'E' /
237 DATA equeds /
'N',
'Y' /
243 path( 1: 1 ) =
'Single precision'
249 iseed( i ) = iseedy( i )
255 $
CALL serrvx( path, nout )
275 nkd = max( 1, min( n, 4 ) )
280 kdval( 2 ) = n + ( n+1 ) / 4
281 kdval( 3 ) = ( 3*n-1 ) / 4
282 kdval( 4 ) = ( n+1 ) / 4
297 IF( iuplo.EQ.1 )
THEN
300 koff = max( 1, kd+2-n )
306 DO 80 imat = 1, nimat
310 IF( .NOT.dotype( imat ) )
315 zerot = imat.GE.2 .AND. imat.LE.4
316 IF( zerot .AND. n.LT.imat-1 )
319 IF( .NOT.zerot .OR. .NOT.dotype( 1 ) )
THEN
324 CALL slatb4( path, imat, n, n,
TYPE, KL, KU, ANORM,
325 $ MODE, CNDNUM, DIST )
328 CALL slatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
329 $ CNDNUM, ANORM, KD, KD, PACKIT,
330 $ A( KOFF ), LDAB, WORK, INFO )
335 CALL alaerh( path,
'SLATMS', info, 0, uplo, n,
336 $ n, -1, -1, -1, imat, nfail, nerrs,
340 ELSE IF( izero.GT.0 )
THEN
346 IF( iuplo.EQ.1 )
THEN
347 ioff = ( izero-1 )*ldab + kd + 1
348 CALL scopy( izero-i1, work( iw ), 1,
349 $ a( ioff-izero+i1 ), 1 )
351 CALL scopy( i2-izero+1, work( iw ), 1,
352 $ a( ioff ), max( ldab-1, 1 ) )
354 ioff = ( i1-1 )*ldab + 1
355 CALL scopy( izero-i1, work( iw ), 1,
356 $ a( ioff+izero-i1 ),
358 ioff = ( izero-1 )*ldab + 1
360 CALL scopy( i2-izero+1, work( iw ), 1,
372 ELSE IF( imat.EQ.3 )
THEN
381 DO 20 i = 1, min( 2*kd+1, n )
385 i1 = max( izero-kd, 1 )
386 i2 = min( izero+kd, n )
388 IF( iuplo.EQ.1 )
THEN
389 ioff = ( izero-1 )*ldab + kd + 1
390 CALL sswap( izero-i1, a( ioff-izero+i1 ), 1,
393 CALL sswap( i2-izero+1, a( ioff ),
394 $ max( ldab-1, 1 ), work( iw ), 1 )
396 ioff = ( i1-1 )*ldab + 1
397 CALL sswap( izero-i1, a( ioff+izero-i1 ),
398 $ max( ldab-1, 1 ), work( iw ), 1 )
399 ioff = ( izero-1 )*ldab + 1
401 CALL sswap( i2-izero+1, a( ioff ), 1,
408 CALL slacpy(
'Full', kd+1, n, a, ldab, asav, ldab )
411 equed = equeds( iequed )
412 IF( iequed.EQ.1 )
THEN
418 DO 60 ifact = 1, nfact
419 fact = facts( ifact )
420 prefac =
lsame( fact,
'F' )
421 nofact =
lsame( fact,
'N' )
422 equil =
lsame( fact,
'E' )
429 ELSE IF( .NOT.
lsame( fact,
'N' ) )
THEN
436 CALL slacpy(
'Full', kd+1, n, asav, ldab,
438 IF( equil .OR. iequed.GT.1 )
THEN
443 CALL spbequ( uplo, n, kd, afac, ldab, s,
444 $ scond, amax, info )
445 IF( info.EQ.0 .AND. n.GT.0 )
THEN
451 CALL slaqsb( uplo, n, kd, afac, ldab,
452 $ s, scond, amax, equed )
464 anorm =
slansb(
'1', uplo, n, kd, afac, ldab,
469 CALL spbtrf( uplo, n, kd, afac, ldab, info )
473 CALL slaset(
'Full', n, n, zero, one, a,
476 CALL spbtrs( uplo, n, kd, n, afac, ldab, a,
481 ainvnm =
slange(
'1', n, n, a, lda, rwork )
482 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
485 rcondc = ( one / anorm ) / ainvnm
491 CALL slacpy(
'Full', kd+1, n, asav, ldab, a,
498 CALL slarhs( path, xtype, uplo,
' ', n, n, kd,
499 $ kd, nrhs, a, ldab, xact, lda, b,
502 CALL slacpy(
'Full', n, nrhs, b, lda, bsav,
512 CALL slacpy(
'Full', kd+1, n, a, ldab, afac,
514 CALL slacpy(
'Full', n, nrhs, b, lda, x,
518 CALL spbsv( uplo, n, kd, nrhs, afac, ldab, x,
523 IF( info.NE.izero )
THEN
524 CALL alaerh( path,
'SPBSV ', info, izero,
525 $ uplo, n, n, kd, kd, nrhs,
526 $ imat, nfail, nerrs, nout )
528 ELSE IF( info.NE.0 )
THEN
535 CALL spbt01( uplo, n, kd, a, ldab, afac,
536 $ ldab, rwork, result( 1 ) )
540 CALL slacpy(
'Full', n, nrhs, b, lda, work,
542 CALL spbt02( uplo, n, kd, nrhs, a, ldab, x,
543 $ lda, work, lda, rwork,
548 CALL sget04( n, nrhs, x, lda, xact, lda,
549 $ rcondc, result( 3 ) )
556 IF( result( k ).GE.thresh )
THEN
557 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
558 $
CALL aladhd( nout, path )
559 WRITE( nout, fmt = 9999 )
'SPBSV ',
560 $ uplo, n, kd, imat, k, result( k )
571 $
CALL slaset(
'Full', kd+1, n, zero, zero,
573 CALL slaset(
'Full', n, nrhs, zero, zero, x,
575 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
580 CALL slaqsb( uplo, n, kd, a, ldab, s, scond,
588 CALL spbsvx( fact, uplo, n, kd, nrhs, a, ldab,
589 $ afac, ldab, equed, s, b, lda, x,
590 $ lda, rcond, rwork, rwork( nrhs+1 ),
591 $ work, iwork, info )
595 IF( info.NE.izero )
THEN
596 CALL alaerh( path,
'SPBSVX', info, izero,
597 $ fact // uplo, n, n, kd, kd,
598 $ nrhs, imat, nfail, nerrs, nout )
603 IF( .NOT.prefac )
THEN
608 CALL spbt01( uplo, n, kd, a, ldab, afac,
609 $ ldab, rwork( 2*nrhs+1 ),
618 CALL slacpy(
'Full', n, nrhs, bsav, lda,
620 CALL spbt02( uplo, n, kd, nrhs, asav, ldab,
622 $ rwork( 2*nrhs+1 ), result( 2 ) )
626 IF( nofact .OR. ( prefac .AND.
lsame( equed,
628 CALL sget04( n, nrhs, x, lda, xact, lda,
629 $ rcondc, result( 3 ) )
631 CALL sget04( n, nrhs, x, lda, xact, lda,
632 $ roldc, result( 3 ) )
638 CALL spbt05( uplo, n, kd, nrhs, asav, ldab,
639 $ b, lda, x, lda, xact, lda,
640 $ rwork, rwork( nrhs+1 ),
649 result( 6 ) =
sget06( rcond, rcondc )
655 IF( result( k ).GE.thresh )
THEN
656 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
657 $
CALL aladhd( nout, path )
659 WRITE( nout, fmt = 9997 )
'SPBSVX',
660 $ fact, uplo, n, kd, equed, imat, k,
663 WRITE( nout, fmt = 9998 )
'SPBSVX',
664 $ fact, uplo, n, kd, imat, k,
680 CALL alasvm( path, nout, nfail, nrun, nerrs )
682 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', KD =', i5,
683 $
', type ', i1,
', test(', i1,
')=', g12.5 )
684 9998
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ', i5,
', ', i5,
685 $
', ... ), type ', i1,
', test(', i1,
')=', g12.5 )
686 9997
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ', i5,
', ', i5,
687 $
', ... ), EQUED=''', a1,
''', type ', i1,
', test(', i1,