156 SUBROUTINE cdrvsy( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
157 $ a, afac, ainv,
b,
x, xact, work, rwork, iwork,
167 INTEGER nmax, nn, nout, nrhs
172 INTEGER iwork( * ), nval( * )
174 COMPLEX a( * ), afac( * ), ainv( * ),
b( * ),
175 $ work( * ),
x( * ), xact( * )
182 parameter( one = 1.0e+0, zero = 0.0e+0 )
183 INTEGER ntypes, ntests
184 parameter( ntypes = 11, ntests = 6 )
186 parameter( nfact = 2 )
190 CHARACTER dist, equed, fact, type, uplo, xtype
192 INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
193 $ izero,
j, k, k1, kl, ku, lda, lwork, mode, n,
194 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt,
196 REAL ainvnm, anorm, cndnum, rcond, rcondc,
200 CHARACTER facts( nfact ), uplos( 2 )
201 INTEGER iseed( 4 ), iseedy( 4 )
202 REAL result( ntests ), berr( nrhs ),
203 $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
221 COMMON / infoc / infot, nunit, ok, lerr
222 COMMON / srnamc / srnamt
225 INTRINSIC cmplx, max, min
228 DATA iseedy / 1988, 1989, 1990, 1991 /
229 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
235 path( 1: 1 ) =
'Complex precision'
241 iseed( i ) = iseedy( i )
243 lwork = max( 2*nmax, nmax*nrhs )
248 $ CALL
cerrvx( path, nout )
268 DO 170 imat = 1, nimat
272 IF( .NOT.dotype( imat ) )
277 zerot = imat.GE.3 .AND. imat.LE.6
278 IF( zerot .AND. n.LT.imat-2 )
284 uplo = uplos( iuplo )
286 IF( imat.NE.ntypes )
THEN
291 CALL
clatb4( path, imat, n, n, type, kl, ku, anorm,
292 $ mode, cndnum, dist )
295 CALL
clatms( n, n, dist, iseed, type, rwork, mode,
296 $ cndnum, anorm, kl, ku, uplo, a, lda,
302 CALL
alaerh( path,
'CLATMS', info, 0, uplo, n, n,
303 $ -1, -1, -1, imat, nfail, nerrs, nout )
313 ELSE IF( imat.EQ.4 )
THEN
323 IF( iuplo.EQ.1 )
THEN
324 ioff = ( izero-1 )*lda
325 DO 20 i = 1, izero - 1
335 DO 40 i = 1, izero - 1
345 IF( iuplo.EQ.1 )
THEN
379 CALL
clatsy( uplo, n, a, lda, iseed )
382 DO 150 ifact = 1, nfact
386 fact = facts( ifact )
396 ELSE IF( ifact.EQ.1 )
THEN
400 anorm =
clansy(
'1', uplo, n, a, lda, rwork )
404 CALL
clacpy( uplo, n, n, a, lda, afac, lda )
405 CALL
csytrf( uplo, n, afac, lda, iwork, work,
410 CALL
clacpy( uplo, n, n, afac, lda, ainv, lda )
411 lwork = (n+nb+1)*(nb+3)
412 CALL
csytri2( uplo, n, ainv, lda, iwork, work,
414 ainvnm =
clansy(
'1', uplo, n, ainv, lda, rwork )
418 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
421 rcondc = ( one / anorm ) / ainvnm
428 CALL
clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
429 $ nrhs, a, lda, xact, lda,
b, lda, iseed,
435 IF( ifact.EQ.2 )
THEN
436 CALL
clacpy( uplo, n, n, a, lda, afac, lda )
437 CALL
clacpy(
'Full', n, nrhs,
b, lda,
x, lda )
442 CALL
csysv( uplo, n, nrhs, afac, lda, iwork,
x,
443 $ lda, work, lwork, info )
451 IF( iwork( k ).LT.0 )
THEN
452 IF( iwork( k ).NE.-k )
THEN
456 ELSE IF( iwork( k ).NE.k )
THEN
465 CALL
alaerh( path,
'CSYSV ', info, k, uplo, n,
466 $ n, -1, -1, nrhs, imat, nfail,
469 ELSE IF( info.NE.0 )
THEN
476 CALL
csyt01( uplo, n, a, lda, afac, lda, iwork,
477 $ ainv, lda, rwork, result( 1 ) )
481 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
482 CALL
csyt02( uplo, n, nrhs, a, lda,
x, lda, work,
483 $ lda, rwork, result( 2 ) )
487 CALL
cget04( n, nrhs,
x, lda, xact, lda, rcondc,
495 IF( result( k ).GE.thresh )
THEN
496 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
497 $ CALL
aladhd( nout, path )
498 WRITE( nout, fmt = 9999 )
'CSYSV ', uplo, n,
499 $ imat, k, result( k )
510 $ CALL
claset( uplo, n, n, cmplx( zero ),
511 $ cmplx( zero ), afac, lda )
512 CALL
claset(
'Full', n, nrhs, cmplx( zero ),
513 $ cmplx( zero ),
x, lda )
519 CALL
csysvx( fact, uplo, n, nrhs, a, lda, afac, lda,
520 $ iwork,
b, lda,
x, lda, rcond, rwork,
521 $ rwork( nrhs+1 ), work, lwork,
522 $ rwork( 2*nrhs+1 ), info )
530 IF( iwork( k ).LT.0 )
THEN
531 IF( iwork( k ).NE.-k )
THEN
535 ELSE IF( iwork( k ).NE.k )
THEN
544 CALL
alaerh( path,
'CSYSVX', info, k, fact // uplo,
545 $ n, n, -1, -1, nrhs, imat, nfail,
551 IF( ifact.GE.2 )
THEN
556 CALL
csyt01( uplo, n, a, lda, afac, lda, iwork,
557 $ ainv, lda, rwork( 2*nrhs+1 ),
566 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
567 CALL
csyt02( uplo, n, nrhs, a, lda,
x, lda, work,
568 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
572 CALL
cget04( n, nrhs,
x, lda, xact, lda, rcondc,
577 CALL
cpot05( uplo, n, nrhs, a, lda,
b, lda,
x, lda,
578 $ xact, lda, rwork, rwork( nrhs+1 ),
587 result( 6 ) =
sget06( rcond, rcondc )
593 IF( result( k ).GE.thresh )
THEN
594 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
595 $ CALL
aladhd( nout, path )
596 WRITE( nout, fmt = 9998 )
'CSYSVX', fact, uplo,
597 $ n, imat, k, result( k )
608 $ CALL
claset( uplo, n, n, cmplx( zero ),
609 $ cmplx( zero ), afac, lda )
610 CALL
claset(
'Full', n, nrhs, cmplx( zero ),
611 $ cmplx( zero ),
x, lda )
619 CALL
csysvxx( fact, uplo, n, nrhs, a, lda, afac,
620 $ lda, iwork, equed, work( n+1 ),
b, lda,
x,
621 $ lda, rcond, rpvgrw_svxx, berr, n_err_bnds,
622 $ errbnds_n, errbnds_c, 0, zero, work,
631 IF( iwork( k ).LT.0 )
THEN
632 IF( iwork( k ).NE.-k )
THEN
636 ELSE IF( iwork( k ).NE.k )
THEN
644 IF( info.NE.k .AND. info.LE.n )
THEN
645 CALL
alaerh( path,
'CSYSVXX', info, k,
646 $ fact // uplo, n, n, -1, -1, nrhs, imat, nfail,
652 IF( ifact.GE.2 )
THEN
657 CALL
csyt01( uplo, n, a, lda, afac, lda, iwork,
658 $ ainv, lda, rwork(2*nrhs+1),
667 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
668 CALL
csyt02( uplo, n, nrhs, a, lda,
x, lda, work,
669 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
674 CALL
cget04( n, nrhs,
x, lda, xact, lda, rcondc,
679 CALL
cpot05( uplo, n, nrhs, a, lda,
b, lda,
x, lda,
680 $ xact, lda, rwork, rwork( nrhs+1 ),
689 result( 6 ) =
sget06( rcond, rcondc )
695 IF( result( k ).GE.thresh )
THEN
696 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
697 $ CALL
aladhd( nout, path )
698 WRITE( nout, fmt = 9998 )
'CSYSVXX',
699 $ fact, uplo, n, imat, k,
714 CALL
alasvm( path, nout, nfail, nrun, nerrs )
721 9999
FORMAT( 1
x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
722 $
', test ', i2,
', ratio =', g12.5 )
723 9998
FORMAT( 1
x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
724 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )
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 clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine clatsy(UPLO, N, X, LDX, ISEED)
CLATSY
subroutine csyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CSYT01
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
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 cpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPOT05
REAL function sget06(RCOND, RCONDC)
SGET06
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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 clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
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 clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine cebchvxx(THRESH, PATH)
CEBCHVXX
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cerrvx(PATH, NUNIT)
CERRVX
subroutine csyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CSYT02
subroutine csytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF
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 cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine cdrvsy(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CDRVSY
subroutine csytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRI2