156 SUBROUTINE cdrvsp( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
157 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
167 INTEGER NMAX, NN, NOUT, NRHS
172 INTEGER IWORK( * ), NVAL( * )
174 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
175 $ work( * ), x( * ), xact( * )
182 PARAMETER ( ONE = 1.0e+0, zero = 0.0e+0 )
183 INTEGER NTYPES, NTESTS
184 parameter( ntypes = 11, ntests = 6 )
186 parameter( nfact = 2 )
190 CHARACTER DIST, FACT, PACKIT,
TYPE, UPLO, XTYPE
192 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
193 $ izero, j, k, k1, kl, ku, lda, mode, n, nb,
194 $ nbmin, nerrs, nfail, nimat, npp, nrun, nt
195 REAL AINVNM, ANORM, CNDNUM, RCOND, RCONDC
198 CHARACTER FACTS( NFACT )
199 INTEGER ISEED( 4 ), ISEEDY( 4 )
200 REAL RESULT( NTESTS )
204 EXTERNAL CLANSP, SGET06
218 COMMON / infoc / infot, nunit, ok, lerr
219 COMMON / srnamc / srnamt
222 INTRINSIC cmplx, max, min
225 DATA iseedy / 1988, 1989, 1990, 1991 /
226 DATA facts /
'F',
'N' /
232 path( 1: 1 ) =
'Complex precision'
238 iseed( i ) = iseedy( i )
244 $
CALL cerrvx( path, nout )
265 DO 170 imat = 1, nimat
269 IF( .NOT.dotype( imat ) )
274 zerot = imat.GE.3 .AND. imat.LE.6
275 IF( zerot .AND. n.LT.imat-2 )
281 IF( iuplo.EQ.1 )
THEN
289 IF( imat.NE.ntypes )
THEN
294 CALL clatb4( path, imat, n, n,
TYPE, kl, ku, anorm,
295 $ mode, cndnum, dist )
298 CALL clatms( n, n, dist, iseed,
TYPE, rwork, mode,
299 $ cndnum, anorm, kl, ku, packit, a, lda,
305 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n,
306 $ -1, -1, -1, imat, nfail, nerrs, nout )
316 ELSE IF( imat.EQ.4 )
THEN
326 IF( iuplo.EQ.1 )
THEN
327 ioff = ( izero-1 )*izero / 2
328 DO 20 i = 1, izero - 1
338 DO 40 i = 1, izero - 1
348 IF( iuplo.EQ.1 )
THEN
382 CALL clatsp( uplo, n, a, iseed )
385 DO 150 ifact = 1, nfact
389 fact = facts( ifact )
399 ELSE IF( ifact.EQ.1 )
THEN
403 anorm = clansp(
'1', uplo, n, a, rwork )
407 CALL ccopy( npp, a, 1, afac, 1 )
408 CALL csptrf( uplo, n, afac, iwork, info )
412 CALL ccopy( npp, afac, 1, ainv, 1 )
413 CALL csptri( uplo, n, ainv, iwork, work, info )
414 ainvnm = clansp(
'1', uplo, n, ainv, rwork )
418 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
421 rcondc = ( one / anorm ) / ainvnm
428 CALL clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
429 $ nrhs, a, lda, xact, lda, b, lda, iseed,
435 IF( ifact.EQ.2 )
THEN
436 CALL ccopy( npp, a, 1, afac, 1 )
437 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
442 CALL cspsv( uplo, n, nrhs, afac, iwork, x, lda,
451 IF( iwork( k ).LT.0 )
THEN
452 IF( iwork( k ).NE.-k )
THEN
456 ELSE IF( iwork( k ).NE.k )
THEN
465 CALL alaerh( path,
'CSPSV ', info, k, uplo, n,
466 $ n, -1, -1, nrhs, imat, nfail,
469 ELSE IF( info.NE.0 )
THEN
476 CALL cspt01( uplo, n, a, afac, iwork, ainv, lda,
477 $ rwork, result( 1 ) )
481 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
482 CALL cspt02( uplo, n, nrhs, a, x, lda, work, lda,
483 $ rwork, result( 2 ) )
487 CALL cget04( 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 )
'CSPSV ', uplo, n,
499 $ imat, k, result( k )
509 IF( ifact.EQ.2 .AND. npp.GT.0 )
510 $
CALL claset(
'Full', npp, 1, cmplx( zero ),
511 $ cmplx( zero ), afac, npp )
512 CALL claset(
'Full', n, nrhs, cmplx( zero ),
513 $ cmplx( zero ), x, lda )
519 CALL cspsvx( fact, uplo, n, nrhs, a, afac, iwork, b,
520 $ lda, x, lda, rcond, rwork,
521 $ rwork( nrhs+1 ), work, rwork( 2*nrhs+1 ),
530 IF( iwork( k ).LT.0 )
THEN
531 IF( iwork( k ).NE.-k )
THEN
535 ELSE IF( iwork( k ).NE.k )
THEN
544 CALL alaerh( path,
'CSPSVX', info, k, fact // uplo,
545 $ n, n, -1, -1, nrhs, imat, nfail,
551 IF( ifact.GE.2 )
THEN
556 CALL cspt01( uplo, n, a, afac, iwork, ainv, lda,
557 $ rwork( 2*nrhs+1 ), result( 1 ) )
565 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
566 CALL cspt02( uplo, n, nrhs, a, x, lda, work, lda,
567 $ rwork( 2*nrhs+1 ), result( 2 ) )
571 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
576 CALL cppt05( uplo, n, nrhs, a, b, lda, x, lda,
577 $ xact, lda, rwork, rwork( nrhs+1 ),
586 result( 6 ) = sget06( rcond, rcondc )
592 IF( result( k ).GE.thresh )
THEN
593 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
594 $
CALL aladhd( nout, path )
595 WRITE( nout, fmt = 9998 )
'CSPSVX', fact, uplo,
596 $ n, imat, k, result( k )
610 CALL alasvm( path, nout, nfail, nrun, nerrs )
612 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
613 $
', test ', i2,
', ratio =', g12.5 )
614 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
615 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )