155 SUBROUTINE cdrvsy_rk( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
156 $ nmax, a, afac, e, ainv, b, x, xact, work,
157 $ rwork, iwork, nout )
166 INTEGER NMAX, NN, NOUT, NRHS
171 INTEGER IWORK( * ), NVAL( * )
173 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
174 $ work( * ), x( * ), xact( * )
181 parameter ( one = 1.0e+0, zero = 0.0e+0 )
182 INTEGER NTYPES, NTESTS
183 parameter ( ntypes = 11, ntests = 3 )
185 parameter ( nfact = 2 )
189 CHARACTER DIST, FACT,
TYPE, UPLO, XTYPE
190 CHARACTER*3 MATPATH, PATH
191 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
192 $ izero, j, k, kl, ku, lda, lwork, mode, n,
193 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
194 REAL AINVNM, ANORM, CNDNUM, RCONDC
197 CHARACTER FACTS( nfact ), UPLOS( 2 )
198 INTEGER ISEED( 4 ), ISEEDY( 4 )
199 REAL RESULT( ntests )
217 COMMON / infoc / infot, nunit, ok, lerr
218 COMMON / srnamc / srnamt
224 DATA iseedy / 1988, 1989, 1990, 1991 /
225 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
233 path( 1: 1 ) =
'Complex precision'
238 matpath( 1: 1 ) =
'Complex precision'
239 matpath( 2: 3 ) =
'SY'
245 iseed( i ) = iseedy( i )
247 lwork = max( 2*nmax, nmax*nrhs )
252 $
CALL cerrvx( path, nout )
273 DO 170 imat = 1, nimat
277 IF( .NOT.dotype( imat ) )
282 zerot = imat.GE.3 .AND. imat.LE.6
283 IF( zerot .AND. n.LT.imat-2 )
289 uplo = uplos( iuplo )
291 IF( imat.NE.ntypes )
THEN
298 CALL clatb4( matpath, imat, n, n,
TYPE, KL, KU, ANORM,
299 $ mode, cndnum, dist )
304 CALL clatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
305 $ cndnum, anorm, kl, ku, uplo, a, lda,
311 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n,
312 $ -1, -1, -1, imat, nfail, nerrs, nout )
322 ELSE IF( imat.EQ.4 )
THEN
332 IF( iuplo.EQ.1 )
THEN
333 ioff = ( izero-1 )*lda
334 DO 20 i = 1, izero - 1
344 DO 40 i = 1, izero - 1
354 IF( iuplo.EQ.1 )
THEN
391 CALL clatsy( uplo, n, a, lda, iseed )
394 DO 150 ifact = 1, nfact
398 fact = facts( ifact )
407 ELSE IF( ifact.EQ.1 )
THEN
411 anorm = clansy(
'1', uplo, n, a, lda, rwork )
416 CALL clacpy( uplo, n, n, a, lda, afac, lda )
417 CALL csytrf_rk( uplo, n, afac, lda, e, iwork, work,
422 CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
423 lwork = (n+nb+1)*(nb+3)
428 CALL csytri_3( uplo, n, ainv, lda, e, iwork,
429 $ work, lwork, info )
430 ainvnm = clansy(
'1', uplo, n, ainv, lda, rwork )
434 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
437 rcondc = ( one / anorm ) / ainvnm
444 CALL clarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
445 $ nrhs, a, lda, xact, lda, b, lda, iseed,
451 IF( ifact.EQ.2 )
THEN
452 CALL clacpy( uplo, n, n, a, lda, afac, lda )
453 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
459 CALL csysv_rk( uplo, n, nrhs, afac, lda, e, iwork,
460 $ x, lda, work, lwork, info )
468 IF( iwork( k ).LT.0 )
THEN
469 IF( iwork( k ).NE.-k )
THEN
473 ELSE IF( iwork( k ).NE.k )
THEN
482 CALL alaerh( path,
'CSYSV_RK', info, k, uplo,
483 $ n, n, -1, -1, nrhs, imat, nfail,
486 ELSE IF( info.NE.0 )
THEN
493 CALL csyt01_3( uplo, n, a, lda, afac, lda, e,
494 $ iwork, ainv, lda, rwork,
499 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
500 CALL csyt02( uplo, n, nrhs, a, lda, x, lda, work,
501 $ lda, rwork, result( 2 ) )
506 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
514 IF( result( k ).GE.thresh )
THEN
515 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
516 $
CALL aladhd( nout, path )
517 WRITE( nout, fmt = 9999 )
'CSYSV_RK', uplo,
518 $ n, imat, k, result( k )
534 CALL alasvm( path, nout, nfail, nrun, nerrs )
536 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
537 $
', test ', i2,
', ratio =', g12.5 )
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
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 csysv_rk(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, LWORK, INFO)
CSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices ...
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 cdrvsy_rk(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CDRVSY_RK
subroutine cerrvx(PATH, NUNIT)
CERRVX
subroutine csytrf_rk(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CSYTRF_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch...
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
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 clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine csyt01_3(UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C, LDC, RWORK, RESID)
CSYT01_3
subroutine csytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CSYTRI_3
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