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 )
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( 1
x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
607 $
', test ', i2,
', ratio =', g12.5 )
608 9998
FORMAT( 1
x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
609 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine zsyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZSYT02
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
DOUBLE PRECISION function zlansy(NORM, UPLO, N, A, LDA, WORK)
ZLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex symmetric matrix.
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
DOUBLE PRECISION function dget06(RCOND, RCONDC)
DGET06
subroutine zdrvsy(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZDRVSY
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
subroutine zlatsy(UPLO, N, X, LDX, ISEED)
ZLATSY
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine zsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRI2
subroutine aladhd(IOUNIT, PATH)
ALADHD
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zsysv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZSYSV computes the solution to system of linear equations A * X = B for SY matrices ...
subroutine zsyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZSYT01
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zsysvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, RWORK, INFO)
ZSYSVX computes the solution to system of linear equations A * X = B for SY matrices ...
subroutine zsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRF
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4