153 $ nmax, a, afac, ainv,
b,
x, xact, work,
154 $ rwork, iwork, nout )
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 = 3 )
182 parameter( nfact = 2 )
186 CHARACTER dist, fact, type, uplo, xtype
187 CHARACTER*3 matpath, path
188 INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
189 $ izero,
j, k, kl, ku, lda, lwork, mode, n,
190 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
191 DOUBLE PRECISION ainvnm, anorm, cndnum, rcondc
194 CHARACTER facts( nfact ), uplos( 2 )
195 INTEGER iseed( 4 ), iseedy( 4 )
196 DOUBLE PRECISION result( ntests )
215 COMMON / infoc / infot, nunit, ok, lerr
216 COMMON / srnamc / srnamt
222 DATA iseedy / 1988, 1989, 1990, 1991 /
223 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
231 path( 1: 1 ) =
'Zomplex precision'
236 matpath( 1: 1 ) =
'Zomplex precision'
237 matpath( 2: 3 ) =
'SY'
243 iseed( i ) = iseedy( i )
245 lwork = max( 2*nmax, nmax*nrhs )
250 $ CALL
zerrvx( path, nout )
271 DO 170 imat = 1, nimat
275 IF( .NOT.dotype( imat ) )
280 zerot = imat.GE.3 .AND. imat.LE.6
281 IF( zerot .AND. n.LT.imat-2 )
287 uplo = uplos( iuplo )
289 IF( imat.NE.ntypes )
THEN
296 CALL
zlatb4( matpath, imat, n, n, type, kl, ku, anorm,
297 $ mode, cndnum, dist )
302 CALL
zlatms( n, n, dist, iseed, type, rwork, mode,
303 $ cndnum, anorm, kl, ku, uplo, a, lda,
309 CALL
alaerh( path,
'ZLATMS', info, 0, uplo, n, n,
310 $ -1, -1, -1, imat, nfail, nerrs, nout )
320 ELSE IF( imat.EQ.4 )
THEN
330 IF( iuplo.EQ.1 )
THEN
331 ioff = ( izero-1 )*lda
332 DO 20 i = 1, izero - 1
342 DO 40 i = 1, izero - 1
352 IF( iuplo.EQ.1 )
THEN
386 CALL
zlatsy( uplo, n, a, lda, iseed )
389 DO 150 ifact = 1, nfact
393 fact = facts( ifact )
403 ELSE IF( ifact.EQ.1 )
THEN
407 anorm =
zlansy(
'1', uplo, n, a, lda, rwork )
412 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
418 CALL
zlacpy( uplo, n, n, afac, lda, ainv, lda )
419 lwork = (n+nb+1)*(nb+3)
422 ainvnm =
zlansy(
'1', uplo, n, ainv, lda, rwork )
426 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
429 rcondc = ( one / anorm ) / ainvnm
436 CALL
zlarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
437 $ nrhs, a, lda, xact, lda,
b, lda, iseed,
443 IF( ifact.EQ.2 )
THEN
444 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
445 CALL
zlacpy(
'Full', n, nrhs,
b, lda,
x, lda )
450 srnamt =
'ZSYSV_ROOK'
451 CALL
zsysv_rook( uplo, n, nrhs, afac, lda, iwork,
452 $
x, lda, work, lwork, info )
460 IF( iwork( k ).LT.0 )
THEN
461 IF( iwork( k ).NE.-k )
THEN
465 ELSE IF( iwork( k ).NE.k )
THEN
474 CALL
alaerh( path,
'ZSYSV_ROOK', info, k, uplo,
475 $ n, n, -1, -1, nrhs, imat, nfail,
478 ELSE IF( info.NE.0 )
THEN
486 $ iwork, ainv, lda, rwork,
491 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
492 CALL
zsyt02( uplo, n, nrhs, a, lda,
x, lda, work,
493 $ lda, rwork, result( 2 ) )
498 CALL
zget04( n, nrhs,
x, lda, xact, lda, rcondc,
506 IF( result( k ).GE.thresh )
THEN
507 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
508 $ CALL
aladhd( nout, path )
509 WRITE( nout, fmt = 9999 )
'ZSYSV_ROOK', uplo,
510 $ n, imat, k, result( k )
526 CALL
alasvm( path, nout, nfail, nrun, nerrs )
528 9999
FORMAT( 1
x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
529 $
', test ', i2,
', ratio =', g12.5 )
subroutine zsyt01_rook(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZSYT01_ROOK
subroutine zdrvsy_rook(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZDRVSY_ROOK
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 zsytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRF_ROOK
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...
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 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_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices ...
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zsytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZSYTRI_ROOK
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4