154 SUBROUTINE cdrvsy( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
155 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
164 INTEGER NMAX, NN, NOUT, NRHS
169 INTEGER IWORK( * ), NVAL( * )
171 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
172 $ work( * ), x( * ), xact( * )
179 PARAMETER ( ONE = 1.0e+0, zero = 0.0e+0 )
180 INTEGER NTYPES, NTESTS
181 parameter( ntypes = 11, ntests = 6 )
183 parameter( nfact = 2 )
187 CHARACTER DIST, EQUED, FACT,
TYPE, UPLO, XTYPE
189 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
190 $ izero, j, k, k1, kl, ku, lda, lwork, mode, n,
191 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt,
193 REAL AINVNM, ANORM, CNDNUM, RCOND, RCONDC,
197 CHARACTER FACTS( NFACT ), UPLOS( 2 )
198 INTEGER ISEED( 4 ), ISEEDY( 4 )
199 REAL RESULT( NTESTS ), BERR( NRHS ),
200 $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
204 EXTERNAL CLANSY, SGET06
218 COMMON / infoc / infot, nunit, ok, lerr
219 COMMON / srnamc / srnamt
225 DATA iseedy / 1988, 1989, 1990, 1991 /
226 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
232 path( 1: 1 ) =
'Complex precision'
238 iseed( i ) = iseedy( i )
240 lwork =
max( 2*nmax, nmax*nrhs )
245 $
CALL cerrvx( path, nout )
265 DO 170 imat = 1, nimat
269 IF( .NOT.dotype( imat ) )
274 zerot = imat.GE.3 .AND. imat.LE.6
275 IF( zerot .AND. n.LT.imat-2 )
281 uplo = uplos( iuplo )
283 IF( imat.NE.ntypes )
THEN
288 CALL clatb4( path, imat, n, n,
TYPE, KL, KU, ANORM,
289 $ MODE, CNDNUM, DIST )
292 CALL clatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
293 $ cndnum, anorm, kl, ku, uplo, a, lda,
299 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n,
300 $ -1, -1, -1, imat, nfail, nerrs, nout )
310 ELSE IF( imat.EQ.4 )
THEN
320 IF( iuplo.EQ.1 )
THEN
321 ioff = ( izero-1 )*lda
322 DO 20 i = 1, izero - 1
332 DO 40 i = 1, izero - 1
342 IF( iuplo.EQ.1 )
THEN
376 CALL clatsy( uplo, n, a, lda, iseed )
379 DO 150 ifact = 1, nfact
383 fact = facts( ifact )
393 ELSE IF( ifact.EQ.1 )
THEN
397 anorm = clansy(
'1', uplo, n, a, lda, rwork )
401 CALL clacpy( uplo, n, n, a, lda, afac, lda )
402 CALL csytrf( uplo, n, afac, lda, iwork, work,
407 CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
408 lwork = (n+nb+1)*(nb+3)
409 CALL csytri2( uplo, n, ainv, lda, iwork, work,
411 ainvnm = clansy(
'1', uplo, n, ainv, lda, rwork )
415 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
418 rcondc = ( one / anorm ) / ainvnm
425 CALL clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
426 $ nrhs, a, lda, xact, lda, b, lda, iseed,
432 IF( ifact.EQ.2 )
THEN
433 CALL clacpy( uplo, n, n, a, lda, afac, lda )
434 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
439 CALL csysv( uplo, n, nrhs, afac, lda, iwork, x,
440 $ lda, work, lwork, info )
448 IF( iwork( k ).LT.0 )
THEN
449 IF( iwork( k ).NE.-k )
THEN
453 ELSE IF( iwork( k ).NE.k )
THEN
463 $ N, -1, -1, NRHS, IMAT, NFAIL,
466.NE.
ELSE IF( INFO0 ) THEN
473 CALL CSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
474 $ AINV, LDA, RWORK, RESULT( 1 ) )
478 CALL CLACPY( 'full
', N, NRHS, B, LDA, WORK, LDA )
479 CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
480 $ LDA, RWORK, RESULT( 2 ) )
484 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
492.GE.
IF( RESULT( K )THRESH ) THEN
493.EQ..AND..EQ.
IF( NFAIL0 NERRS0 )
494 $ CALL ALADHD( NOUT, PATH )
495 WRITE( NOUT, FMT = 9999 )'csysv ', UPLO, N,
496 $ IMAT, K, RESULT( K )
507 $ CALL CLASET( UPLO, N, N, CMPLX( ZERO ),
508 $ CMPLX( ZERO ), AFAC, LDA )
509 CALL CLASET( 'full
', N, NRHS, CMPLX( ZERO ),
510 $ CMPLX( ZERO ), X, LDA )
516 CALL CSYSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA,
517 $ IWORK, B, LDA, X, LDA, RCOND, RWORK,
518 $ RWORK( NRHS+1 ), WORK, LWORK,
519 $ RWORK( 2*NRHS+1 ), INFO )
527.LT.
IF( IWORK( K )0 ) THEN
528.NE.
IF( IWORK( K )-K ) THEN
532.NE.
ELSE IF( IWORK( K )K ) THEN
541 CALL ALAERH( PATH, 'csysvx', INFO, K, FACT // UPLO,
542 $ N, N, -1, -1, NRHS, IMAT, NFAIL,
548.GE.
IF( IFACT2 ) THEN
553 CALL CSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
554 $ AINV, LDA, RWORK( 2*NRHS+1 ),
563 CALL CLACPY( 'full
', N, NRHS, B, LDA, WORK, LDA )
564 CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
565 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
569 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
574 CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
575 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
584 RESULT( 6 ) = SGET06( RCOND, RCONDC )
590.GE.
IF( RESULT( K )THRESH ) THEN
591.EQ..AND..EQ.
IF( NFAIL0 NERRS0 )
592 $ CALL ALADHD( NOUT, PATH )
593 WRITE( NOUT, FMT = 9998 )'csysvx', FACT, UPLO,
594 $ N, IMAT, K, RESULT( K )
605 $ CALL CLASET( UPLO, N, N, CMPLX( ZERO ),
606 $ CMPLX( ZERO ), AFAC, LDA )
607 CALL CLASET( 'full
', N, NRHS, CMPLX( ZERO ),
608 $ CMPLX( ZERO ), X, LDA )
616 CALL CSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
617 $ LDA, IWORK, EQUED, WORK( N+1 ), B, LDA, X,
618 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
619 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
628.LT.
IF( IWORK( K )0 ) THEN
629.NE.
IF( IWORK( K )-K ) THEN
633.NE.
ELSE IF( IWORK( K )K ) THEN
641.NE..AND..LE.
IF( INFOK INFON ) THEN
642 CALL ALAERH( PATH, 'csysvxx', INFO, K,
643 $ FACT // UPLO, N, N, -1, -1, NRHS, IMAT, NFAIL,
649.GE.
IF( IFACT2 ) THEN
654 CALL CSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
655 $ AINV, LDA, RWORK(2*NRHS+1),
664 CALL CLACPY( 'full
', N, NRHS, B, LDA, WORK, LDA )
665 CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
666 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
671 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
676 CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
677 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
686 RESULT( 6 ) = SGET06( RCOND, RCONDC )
692.GE.
IF( RESULT( K )THRESH ) THEN
693.EQ..AND..EQ.
IF( NFAIL0 NERRS0 )
694 $ CALL ALADHD( NOUT, PATH )
695 WRITE( NOUT, FMT = 9998 )'csysvxx',
696 $ FACT, UPLO, N, IMAT, K,
711 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
716 CALL CEBCHVXX(THRESH, PATH)
718 9999 FORMAT( 1X, A, ', uplo=
''', A1, ''', n =
', I5, ',
type ', I2,
719 $ ', test
', I2, ', ratio =
', G12.5 )
720 9998 FORMAT( 1X, A, ', fact=
''', A1, ''', uplo=
''', A1, ''', n =
', I5,
721 $ ',
type ', I2, ', test
', I2, ', ratio =
', G12.5 )
subroutine xlaenv(ispec, nvalue)
XLAENV
subroutine alasvm(type, nout, nfail, nrun, nerrs)
ALASVM
subroutine aladhd(iounit, path)
ALADHD
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
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 csytrf(uplo, n, a, lda, ipiv, work, lwork, info)
CSYTRF
subroutine csytri2(uplo, n, a, lda, ipiv, work, lwork, info)
CSYTRI2
subroutine csysvxx(fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork, info)
CSYSVXX computes the solution to system of linear equations A * X = B for SY matrices
subroutine csysv(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
CSYSV computes the solution to system of linear equations A * X = B for SY matrices
subroutine csysvx(fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, lwork, rwork, info)
CSYSVX 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 cerrvx(path, nunit)
CERRVX
subroutine cdrvsy(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
CDRVSY
subroutine clatsy(uplo, n, x, ldx, iseed)
CLATSY
subroutine csyt01(uplo, n, a, lda, afac, ldafac, ipiv, c, ldc, rwork, resid)
CSYT01
subroutine cpot05(uplo, n, nrhs, a, lda, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
CPOT05
subroutine csyt02(uplo, n, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
CSYT02
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 clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS