156 SUBROUTINE zdrvsy( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
157 $ a, afac, ainv, b, x, xact, work, rwork, iwork,
167 INTEGER nmax, nn, nout, nrhs
168 DOUBLE PRECISION thresh
172 INTEGER iwork( * ), nval( * )
173 DOUBLE PRECISION rwork( * )
174 COMPLEX*16 a( * ), afac( * ), ainv( * ), b( * ),
175 $ work( * ), x( * ), xact( * )
181 DOUBLE PRECISION one, zero
182 parameter( one = 1.0d+0, zero = 0.0d+0 )
183 INTEGER ntypes, ntests
184 parameter( ntypes = 11, ntests = 6 )
186 parameter( nfact = 2 )
190 CHARACTER dist, equed, fact, type, uplo, xtype
192 INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
193 $ izero, j, k, k1, kl, ku, lda, lwork, mode, n,
194 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt,
196 DOUBLE PRECISION ainvnm, anorm, cndnum, rcond, rcondc,
200 CHARACTER facts( nfact ), uplos( 2 )
201 INTEGER iseed( 4 ), iseedy( 4 )
202 DOUBLE PRECISION result( ntests ), berr( nrhs ),
203 $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
221 common / infoc / infot, nunit, ok, lerr
222 common / srnamc / srnamt
225 INTRINSIC dcmplx, max, min
228 DATA iseedy / 1988, 1989, 1990, 1991 /
229 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
235 path( 1: 1 ) =
'Zomplex precision'
241 iseed( i ) = iseedy( i )
243 lwork = max( 2*nmax, nmax*nrhs )
248 $ CALL
zerrvx( path, nout )
268 DO 170 imat = 1, nimat
272 IF( .NOT.dotype( imat ) )
277 zerot = imat.GE.3 .AND. imat.LE.6
278 IF( zerot .AND. n.LT.imat-2 )
284 uplo = uplos( iuplo )
286 IF( imat.NE.ntypes )
THEN
291 CALL
zlatb4( path, imat, n, n, type, kl, ku, anorm,
292 $ mode, cndnum, dist )
295 CALL
zlatms( n, n, dist, iseed, type, rwork, mode,
296 $ cndnum, anorm, kl, ku, uplo, a, lda,
302 CALL
alaerh( path,
'ZLATMS', info, 0, uplo, n, n,
303 $ -1, -1, -1, imat, nfail, nerrs, nout )
313 ELSE IF( imat.EQ.4 )
THEN
323 IF( iuplo.EQ.1 )
THEN
324 ioff = ( izero-1 )*lda
325 DO 20 i = 1, izero - 1
335 DO 40 i = 1, izero - 1
345 IF( iuplo.EQ.1 )
THEN
379 CALL
zlatsy( uplo, n, a, lda, iseed )
382 DO 150 ifact = 1, nfact
386 fact = facts( ifact )
396 ELSE IF( ifact.EQ.1 )
THEN
400 anorm =
zlansy(
'1', uplo, n, a, lda, rwork )
404 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
405 CALL
zsytrf( uplo, n, afac, lda, iwork, work,
410 CALL
zlacpy( uplo, n, n, afac, lda, ainv, lda )
411 lwork = (n+nb+1)*(nb+3)
412 CALL
zsytri2( uplo, n, ainv, lda, iwork, work,
414 ainvnm =
zlansy(
'1', uplo, n, ainv, lda, rwork )
418 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
421 rcondc = ( one / anorm ) / ainvnm
428 CALL
zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
429 $ nrhs, a, lda, xact, lda, b, lda, iseed,
435 IF( ifact.EQ.2 )
THEN
436 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
437 CALL
zlacpy(
'Full', n, nrhs, b, lda, x, lda )
442 CALL
zsysv( uplo, n, nrhs, afac, lda, iwork, x,
443 $ lda, work, lwork, info )
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,
'ZSYSV ', info, k, uplo, n,
466 $ n, -1, -1, nrhs, imat, nfail,
469 ELSE IF( info.NE.0 )
THEN
476 CALL
zsyt01( uplo, n, a, lda, afac, lda, iwork,
477 $ ainv, lda, rwork, result( 1 ) )
481 CALL
zlacpy(
'Full', n, nrhs, b, lda, work, lda )
482 CALL
zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
483 $ lda, rwork, result( 2 ) )
487 CALL
zget04( 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 )
'ZSYSV ', uplo, n,
499 $ imat, k, result( k )
510 $ CALL
zlaset( uplo, n, n, dcmplx( zero ),
511 $ dcmplx( zero ), afac, lda )
512 CALL
zlaset(
'Full', n, nrhs, dcmplx( zero ),
513 $ dcmplx( zero ), x, lda )
519 CALL
zsysvx( fact, uplo, n, nrhs, a, lda, afac, lda,
520 $ iwork, b, lda, x, lda, rcond, rwork,
521 $ rwork( nrhs+1 ), work, lwork,
522 $ rwork( 2*nrhs+1 ), info )
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,
'ZSYSVX', info, k, fact // uplo,
545 $ n, n, -1, -1, nrhs, imat, nfail,
551 IF( ifact.GE.2 )
THEN
556 CALL
zsyt01( uplo, n, a, lda, afac, lda, iwork,
557 $ ainv, lda, rwork( 2*nrhs+1 ),
566 CALL
zlacpy(
'Full', n, nrhs, b, lda, work, lda )
567 CALL
zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
568 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
572 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
577 CALL
zpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
578 $ xact, lda, rwork, rwork( nrhs+1 ),
587 result( 6 ) =
dget06( rcond, rcondc )
593 IF( result( k ).GE.thresh )
THEN
594 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
595 $ CALL
aladhd( nout, path )
596 WRITE( nout, fmt = 9998 )
'ZSYSVX', fact, uplo,
597 $ n, imat, k, result( k )
608 $ CALL
zlaset( uplo, n, n, cmplx( zero ),
609 $ cmplx( zero ), afac, lda )
610 CALL
zlaset(
'Full', n, nrhs, cmplx( zero ),
611 $ cmplx( zero ), x, lda )
619 CALL
zsysvxx( fact, uplo, n, nrhs, a, lda, afac,
620 $ lda, iwork, equed, work( n+1 ), b, lda, x,
621 $ lda, rcond, rpvgrw_svxx, berr, n_err_bnds,
622 $ errbnds_n, errbnds_c, 0, zero, work,
631 IF( iwork( k ).LT.0 )
THEN
632 IF( iwork( k ).NE.-k )
THEN
636 ELSE IF( iwork( k ).NE.k )
THEN
644 IF( info.NE.k .AND. info.LE.n )
THEN
645 CALL
alaerh( path,
'ZSYSVXX', info, k,
646 $ fact // uplo, n, n, -1, -1, nrhs, imat, nfail,
652 IF( ifact.GE.2 )
THEN
657 CALL
zsyt01( uplo, n, a, lda, afac, lda, iwork,
658 $ ainv, lda, rwork(2*nrhs+1),
667 CALL
zlacpy(
'Full', n, nrhs, b, lda, work, lda )
668 CALL
zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
669 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
674 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
679 CALL
zpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
680 $ xact, lda, rwork, rwork( nrhs+1 ),
689 result( 6 ) =
dget06( rcond, rcondc )
695 IF( result( k ).GE.thresh )
THEN
696 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
697 $ CALL
aladhd( nout, path )
698 WRITE( nout, fmt = 9998 )
'ZSYSVXX',
699 $ fact, uplo, n, imat, k,
714 CALL
alasvm( path, nout, nfail, nrun, nerrs )
721 9999 format( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
722 $
', test ', i2,
', ratio =', g12.5 )
723 9998 format( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
724 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )