152 SUBROUTINE zdrvsy( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
153 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
163 INTEGER nmax, nn, nout, nrhs
164 DOUBLE PRECISION thresh
168 INTEGER IWORK( * ), NVAL( * )
169 DOUBLE PRECISION RWORK( * )
170 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
171 $ work( * ), x( * ), xact( * )
177 DOUBLE PRECISION ONE, ZERO
178 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
179 INTEGER NTYPES, NTESTS
180 parameter( ntypes = 11, ntests = 6 )
182 parameter( nfact = 2 )
186 CHARACTER DIST, FACT,
TYPE, UPLO, XTYPE
188 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
189 $ izero, j, k, k1, kl, ku, lda, lwork, mode, n,
190 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
191 DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCOND, RCONDC
194 CHARACTER FACTS( NFACT ), UPLOS( 2 )
195 INTEGER ISEED( 4 ), ISEEDY( 4 )
196 DOUBLE PRECISION RESULT( NTESTS )
199 DOUBLE PRECISION DGET06, ZLANSY
200 EXTERNAL DGET06, ZLANSY
214 COMMON / infoc / infot, nunit, ok, lerr
215 COMMON / srnamc / srnamt
218 INTRINSIC dcmplx, max, min
221 DATA iseedy / 1988, 1989, 1990, 1991 /
222 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
228 path( 1: 1 ) =
'Zomplex precision'
234 iseed( i ) = iseedy( i )
236 lwork = max( 2*nmax, nmax*nrhs )
241 $
CALL zerrvx( path, nout )
261 DO 170 imat = 1, nimat
265 IF( .NOT.dotype( imat ) )
270 zerot = imat.GE.3 .AND. imat.LE.6
271 IF( zerot .AND. n.LT.imat-2 )
277 uplo = uplos( iuplo )
279 IF( imat.NE.ntypes )
THEN
284 CALL zlatb4( path, imat, n, n,
TYPE, kl, ku, anorm,
285 $ mode, cndnum, dist )
288 CALL zlatms( n, n, dist, iseed,
TYPE, rwork, mode,
289 $ cndnum, anorm, kl, ku, uplo, a, lda,
295 CALL alaerh( path,
'ZLATMS', info, 0, uplo, n, n,
296 $ -1, -1, -1, imat, nfail, nerrs, nout )
306 ELSE IF( imat.EQ.4 )
THEN
316 IF( iuplo.EQ.1 )
THEN
317 ioff = ( izero-1 )*lda
318 DO 20 i = 1, izero - 1
328 DO 40 i = 1, izero - 1
338 IF( iuplo.EQ.1 )
THEN
372 CALL zlatsy( uplo, n, a, lda, iseed )
375 DO 150 ifact = 1, nfact
379 fact = facts( ifact )
389 ELSE IF( ifact.EQ.1 )
THEN
393 anorm = zlansy(
'1', uplo, n, a, lda, rwork )
397 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
398 CALL zsytrf( uplo, n, afac, lda, iwork, work,
403 CALL zlacpy( uplo, n, n, afac, lda, ainv, lda )
404 lwork = (n+nb+1)*(nb+3)
405 CALL zsytri2( uplo, n, ainv, lda, iwork, work,
407 ainvnm = zlansy(
'1', uplo, n, ainv, lda, rwork )
411 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
414 rcondc = ( one / anorm ) / ainvnm
421 CALL zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
422 $ nrhs, a, lda, xact, lda, b, lda, iseed,
428 IF( ifact.EQ.2 )
THEN
429 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
430 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
435 CALL zsysv( uplo, n, nrhs, afac, lda, iwork, x,
436 $ lda, work, lwork, info )
444 IF( iwork( k ).LT.0 )
THEN
445 IF( iwork( k ).NE.-k )
THEN
449 ELSE IF( iwork( k ).NE.k )
THEN
458 CALL alaerh( path,
'ZSYSV ', info, k, uplo, n,
459 $ n, -1, -1, nrhs, imat, nfail,
462 ELSE IF( info.NE.0 )
THEN
469 CALL zsyt01( uplo, n, a, lda, afac, lda, iwork,
470 $ ainv, lda, rwork, result( 1 ) )
474 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
475 CALL zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
476 $ lda, rwork, result( 2 ) )
480 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
488 IF( result( k ).GE.thresh )
THEN
489 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
490 $
CALL aladhd( nout, path )
491 WRITE( nout, fmt = 9999 )
'ZSYSV ', uplo, n,
492 $ imat, k, result( k )
503 $
CALL zlaset( uplo, n, n, dcmplx( zero ),
504 $ dcmplx( zero ), afac, lda )
505 CALL zlaset(
'Full', n, nrhs, dcmplx( zero ),
506 $ dcmplx( zero ), x, lda )
512 CALL zsysvx( fact, uplo, n, nrhs, a, lda, afac, lda,
513 $ iwork, b, lda, x, lda, rcond, rwork,
514 $ rwork( nrhs+1 ), work, lwork,
515 $ rwork( 2*nrhs+1 ), info )
523 IF( iwork( k ).LT.0 )
THEN
524 IF( iwork( k ).NE.-k )
THEN
528 ELSE IF( iwork( k ).NE.k )
THEN
537 CALL alaerh( path,
'ZSYSVX', info, k, fact // uplo,
538 $ n, n, -1, -1, nrhs, imat, nfail,
544 IF( ifact.GE.2 )
THEN
549 CALL zsyt01( uplo, n, a, lda, afac, lda, iwork,
550 $ ainv, lda, rwork( 2*nrhs+1 ),
559 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
560 CALL zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
561 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
565 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
570 CALL zpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
571 $ xact, lda, rwork, rwork( nrhs+1 ),
580 result( 6 ) = dget06( rcond, rcondc )
586 IF( result( k ).GE.thresh )
THEN
587 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
588 $
CALL aladhd( nout, path )
589 WRITE( nout, fmt = 9998 )
'ZSYSVX', fact, uplo,
590 $ n, imat, k, result( k )
604 CALL alasvm( path, nout, nfail, nrun, nerrs )
606 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
607 $
', test ', i2,
', ratio =', g12.5 )
608 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
609 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )