156 SUBROUTINE cdrvsp( 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, fact, packit, type, uplo, xtype
192 INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
193 $ izero,
j, k, k1, kl, ku, lda, mode, n, nb,
194 $ nbmin, nerrs, nfail, nimat, npp, nrun, nt
195 REAL ainvnm, anorm, cndnum, rcond, rcondc
198 CHARACTER facts( nfact )
199 INTEGER iseed( 4 ), iseedy( 4 )
200 REAL result( ntests )
218 COMMON / infoc / infot, nunit, ok, lerr
219 COMMON / srnamc / srnamt
222 INTRINSIC cmplx, max, min
225 DATA iseedy / 1988, 1989, 1990, 1991 /
226 DATA facts /
'F',
'N' /
232 path( 1: 1 ) =
'Complex precision'
238 iseed( i ) = iseedy( i )
244 $ 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 IF( iuplo.EQ.1 )
THEN
289 IF( imat.NE.ntypes )
THEN
294 CALL
clatb4( path, imat, n, n, type, kl, ku, anorm,
295 $ mode, cndnum, dist )
298 CALL
clatms( n, n, dist, iseed, type, rwork, mode,
299 $ cndnum, anorm, kl, ku, packit, a, lda,
305 CALL
alaerh( path,
'CLATMS', info, 0, uplo, n, n,
306 $ -1, -1, -1, imat, nfail, nerrs, nout )
316 ELSE IF( imat.EQ.4 )
THEN
326 IF( iuplo.EQ.1 )
THEN
327 ioff = ( izero-1 )*izero / 2
328 DO 20 i = 1, izero - 1
338 DO 40 i = 1, izero - 1
348 IF( iuplo.EQ.1 )
THEN
382 CALL
clatsp( uplo, n, a, iseed )
385 DO 150 ifact = 1, nfact
389 fact = facts( ifact )
399 ELSE IF( ifact.EQ.1 )
THEN
403 anorm =
clansp(
'1', uplo, n, a, rwork )
407 CALL
ccopy( npp, a, 1, afac, 1 )
408 CALL
csptrf( uplo, n, afac, iwork, info )
412 CALL
ccopy( npp, afac, 1, ainv, 1 )
413 CALL
csptri( uplo, n, ainv, iwork, work, info )
414 ainvnm =
clansp(
'1', uplo, n, ainv, 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
ccopy( npp, a, 1, afac, 1 )
437 CALL
clacpy(
'Full', n, nrhs,
b, lda,
x, lda )
442 CALL
cspsv( uplo, n, nrhs, afac, iwork,
x, lda,
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,
'CSPSV ', info, k, uplo, n,
466 $ n, -1, -1, nrhs, imat, nfail,
469 ELSE IF( info.NE.0 )
THEN
476 CALL
cspt01( uplo, n, a, afac, iwork, ainv, lda,
477 $ rwork, result( 1 ) )
481 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
482 CALL
cspt02( uplo, n, nrhs, a,
x, lda, work, lda,
483 $ 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 )
'CSPSV ', uplo, n,
499 $ imat, k, result( k )
509 IF( ifact.EQ.2 .AND. npp.GT.0 )
510 $ CALL
claset(
'Full', npp, 1, cmplx( zero ),
511 $ cmplx( zero ), afac, npp )
512 CALL
claset(
'Full', n, nrhs, cmplx( zero ),
513 $ cmplx( zero ),
x, lda )
519 CALL
cspsvx( fact, uplo, n, nrhs, a, afac, iwork,
b,
520 $ lda,
x, lda, rcond, rwork,
521 $ rwork( nrhs+1 ), work, rwork( 2*nrhs+1 ),
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,
'CSPSVX', info, k, fact // uplo,
545 $ n, n, -1, -1, nrhs, imat, nfail,
551 IF( ifact.GE.2 )
THEN
556 CALL
cspt01( uplo, n, a, afac, iwork, ainv, lda,
557 $ rwork( 2*nrhs+1 ), result( 1 ) )
565 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
566 CALL
cspt02( uplo, n, nrhs, a,
x, lda, work, lda,
567 $ rwork( 2*nrhs+1 ), result( 2 ) )
571 CALL
cget04( n, nrhs,
x, lda, xact, lda, rcondc,
576 CALL
cppt05( uplo, n, nrhs, a,
b, lda,
x, lda,
577 $ xact, lda, rwork, rwork( nrhs+1 ),
586 result( 6 ) =
sget06( rcond, rcondc )
592 IF( result( k ).GE.thresh )
THEN
593 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
594 $ CALL
aladhd( nout, path )
595 WRITE( nout, fmt = 9998 )
'CSPSVX', fact, uplo,
596 $ n, imat, k, result( k )
610 CALL
alasvm( path, nout, nfail, nrun, nerrs )
612 9999
FORMAT( 1
x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
613 $
', test ', i2,
', ratio =', g12.5 )
614 9998
FORMAT( 1
x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
615 $
', 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 csptrf(UPLO, N, AP, IPIV, INFO)
CSPTRF
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine clatsp(UPLO, N, X, ISEED)
CLATSP
subroutine cspsvx(FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
REAL function sget06(RCOND, RCONDC)
SGET06
subroutine cppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPPT05
subroutine cspsv(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CSPSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cspt01(UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
CSPT01
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine cspt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
CSPT02
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
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 csptri(UPLO, N, AP, IPIV, WORK, INFO)
CSPTRI
subroutine cerrvx(PATH, NUNIT)
CERRVX
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
REAL function clansp(NORM, UPLO, N, AP, WORK)
CLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.
subroutine cdrvsp(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CDRVSP
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04