162 INTEGER nmax, nn, nout, nrhs
167 INTEGER iwork( * ), nval( * )
169 COMPLEX a( * ), afac( * ), ainv( * ), b( * ),
170 $ work( * ), x( * ), xact( * )
177 parameter ( one = 1.0e+0, zero = 0.0e+0 )
178 INTEGER ntypes, ntests
179 parameter ( ntypes = 11, ntests = 3 )
181 parameter ( nfact = 2 )
185 CHARACTER dist, fact,
TYPE, uplo, xtype
186 CHARACTER*3 matpath, path
187 INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
188 $ izero, j, k, kl, ku, lda, lwork, mode, n,
189 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
190 REAL ainvnm, anorm, cndnum, rcondc
193 CHARACTER facts( nfact ), uplos( 2 )
194 INTEGER iseed( 4 ), iseedy( 4 )
195 REAL result( ntests )
214 COMMON / infoc / infot, nunit, ok, lerr
215 COMMON / srnamc / srnamt
221 DATA iseedy / 1988, 1989, 1990, 1991 /
222 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
230 path( 1: 1 ) =
'Complex precision'
235 matpath( 1: 1 ) =
'Complex precision'
236 matpath( 2: 3 ) =
'SY'
242 iseed( i ) = iseedy( i )
244 lwork = max( 2*nmax, nmax*nrhs )
249 $
CALL cerrvx( path, nout )
270 DO 170 imat = 1, nimat
274 IF( .NOT.dotype( imat ) )
279 zerot = imat.GE.3 .AND. imat.LE.6
280 IF( zerot .AND. n.LT.imat-2 )
286 uplo = uplos( iuplo )
288 IF( imat.NE.ntypes )
THEN
295 CALL clatb4( matpath, imat, n, n,
TYPE, kl, ku, anorm,
296 $ mode, cndnum, dist )
301 CALL clatms( n, n, dist, iseed,
TYPE, rwork, mode,
302 $ cndnum, anorm, kl, ku, uplo, a, lda,
308 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n,
309 $ -1, -1, -1, imat, nfail, nerrs, nout )
319 ELSE IF( imat.EQ.4 )
THEN
329 IF( iuplo.EQ.1 )
THEN
330 ioff = ( izero-1 )*lda
331 DO 20 i = 1, izero - 1
341 DO 40 i = 1, izero - 1
351 IF( iuplo.EQ.1 )
THEN
388 CALL clatsy( uplo, n, a, lda, iseed )
391 DO 150 ifact = 1, nfact
395 fact = facts( ifact )
405 ELSE IF( ifact.EQ.1 )
THEN
409 anorm =
clansy(
'1', uplo, n, a, lda, rwork )
414 CALL clacpy( uplo, n, n, a, lda, afac, lda )
420 CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
421 lwork = (n+nb+1)*(nb+3)
424 ainvnm =
clansy(
'1', uplo, n, ainv, lda, rwork )
428 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
431 rcondc = ( one / anorm ) / ainvnm
438 CALL clarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
439 $ nrhs, a, lda, xact, lda, b, lda, iseed,
445 IF( ifact.EQ.2 )
THEN
446 CALL clacpy( uplo, n, n, a, lda, afac, lda )
447 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
452 srnamt =
'CSYSV_ROOK'
453 CALL csysv_rook( uplo, n, nrhs, afac, lda, iwork,
454 $ x, lda, work, lwork, info )
462 IF( iwork( k ).LT.0 )
THEN
463 IF( iwork( k ).NE.-k )
THEN
467 ELSE IF( iwork( k ).NE.k )
THEN
476 CALL alaerh( path,
'CSYSV_ROOK', info, k, uplo,
477 $ n, n, -1, -1, nrhs, imat, nfail,
480 ELSE IF( info.NE.0 )
THEN
488 $ iwork, ainv, lda, rwork,
493 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
494 CALL csyt02( uplo, n, nrhs, a, lda, x, lda, work,
495 $ lda, rwork, result( 2 ) )
500 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
508 IF( result( k ).GE.thresh )
THEN
509 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
510 $
CALL aladhd( nout, path )
511 WRITE( nout, fmt = 9999 )
'CSYSV_ROOK', uplo,
512 $ n, imat, k, result( k )
528 CALL alasvm( path, nout, nfail, nrun, nerrs )
530 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
531 $
', test ', i2,
', ratio =', g12.5 )
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine csytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI_ROOK
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine clatsy(UPLO, N, X, LDX, ISEED)
CLATSY
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine csyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CSYT02
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine cerrvx(PATH, NUNIT)
CERRVX
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine csysv_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices ...
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine csytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_ROOK
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
real function clansy(NORM, UPLO, N, A, LDA, WORK)
CLANSY 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 cpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPOT05
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine csyt01_rook(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CSYT01_ROOK