161 SUBROUTINE zdrvge( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
162 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
163 $ RWORK, IWORK, NOUT )
171 INTEGER NMAX, NN, NOUT, NRHS
172 DOUBLE PRECISION THRESH
176 INTEGER IWORK( * ), NVAL( * )
177 DOUBLE PRECISION RWORK( * ), S( * )
178 COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
179 $ bsav( * ), work( * ), x( * ), xact( * )
185 DOUBLE PRECISION ONE, ZERO
186 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
188 PARAMETER ( ntypes = 11 )
190 parameter( ntests = 7 )
192 parameter( ntran = 3 )
195 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
196 CHARACTER DIST, EQUED, FACT, TRANS,
TYPE, XTYPE
198 INTEGER , IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN,
199 $ izero, k, k1, kl, ku, lda, lwork, mode, n, nb,
200 $ nbmin, nerrs, nfact, nfail, nimat, nrun, nt
201 DOUBLE PRECISION AINVNM, AMAX, , ANORMI, ANORMO, CNDNUM,
202 $ , RCONDC, RCONDI, RCONDO, ROLDC,
203 $ roldi, roldo, rowcnd, rpvgrw
206 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
207 INTEGER ISEED( 4 ), ISEEDY( 4 )
208 DOUBLE PRECISION RDUM( 1 ), RESULT( NTESTS )
212 DOUBLE PRECISION DGET06, DLAMCH, ZLANGE, ZLANTR
213 EXTERNAL lsame, dget06, dlamch, zlange, zlantr
222 INTRINSIC abs, dcmplx,
max
230 COMMON / infoc / infot, nunit, ok, lerr
231 COMMON / srnamc / srnamt
234 DATA iseedy / 1988, 1989, 1990, 1991 /
235 DATA transs /
'N',
'T',
'C' /
236 DATA facts / 'f
', 'n
', 'e
' /
237 DATA EQUEDS / 'n
', 'r
', 'c
', 'b
' /
243 PATH( 1: 1 ) = 'zomplex precision
'
249 ISEED( I ) = ISEEDY( I )
255 $ CALL ZERRVX( PATH, NOUT )
263 CALL XLAENV( 2, NBMIN )
275 DO 80 IMAT = 1, NIMAT
279.NOT.
IF( DOTYPE( IMAT ) )
284.GE..AND..LE.
ZEROT = IMAT5 IMAT7
285.AND..LT.
IF( ZEROT NIMAT-4 )
291 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
293 RCONDC = ONE / CNDNUM
296 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM,
297 $ ANORM, KL, KU, 'no packing
', A, LDA, WORK,
303 CALL ALAERH( PATH, 'zlatms', INFO, 0, ' ', N, N, -1, -1,
304 $ -1, IMAT, NFAIL, NERRS, NOUT )
314.EQ.
ELSE IF( IMAT6 ) THEN
319 IOFF = ( IZERO-1 )*LDA
325 CALL ZLASET( 'full
', N, N-IZERO+1, DCMPLX( ZERO ),
326 $ DCMPLX( ZERO ), A( IOFF+1 ), LDA )
334 CALL ZLACPY( 'full
', N, N, A, LDA, ASAV, LDA )
337 EQUED = EQUEDS( IEQUED )
338.EQ.
IF( IEQUED1 ) THEN
344 DO 60 IFACT = 1, NFACT
345 FACT = FACTS( IFACT )
346 PREFAC = LSAME( FACT, 'f
' )
347 NOFACT = LSAME( FACT, 'n
' )
348 EQUIL = LSAME( FACT, 'e
' )
356.NOT.
ELSE IF( NOFACT ) THEN
363 CALL ZLACPY( 'full
', N, N, ASAV, LDA, AFAC, LDA )
364.OR..GT.
IF( EQUIL IEQUED1 ) THEN
369 CALL ZGEEQU( N, N, AFAC, LDA, S, S( N+1 ),
370 $ ROWCND, COLCND, AMAX, INFO )
371.EQ..AND..GT.
IF( INFO0 N0 ) THEN
372 IF( LSAME( EQUED, 'r
' ) ) THEN
375 ELSE IF( LSAME( EQUED, 'c
' ) ) THEN
378 ELSE IF( LSAME( EQUED, 'b
' ) ) THEN
385 CALL ZLAQGE( N, N, AFAC, LDA, S, S( N+1 ),
386 $ ROWCND, COLCND, AMAX, EQUED )
400 ANORMO = ZLANGE( '1
', N, N, AFAC, LDA, RWORK )
401 ANORMI = ZLANGE( 'i
', N, N, AFAC, LDA, RWORK )
406 CALL ZGETRF( N, N, AFAC, LDA, IWORK, INFO )
410 CALL ZLACPY( 'full
', N, N, AFAC, LDA, A, LDA )
411 LWORK = NMAX*MAX( 3, NRHS )
413 CALL ZGETRI( N, A, LDA, IWORK, WORK, LWORK, INFO )
417 AINVNM = ZLANGE( '1
', N, N, A, LDA, RWORK )
418.LE..OR..LE.
IF( ANORMOZERO AINVNMZERO ) THEN
421 RCONDO = ( ONE / ANORMO ) / AINVNM
426 AINVNM = ZLANGE( 'i
', N, N, A, LDA, RWORK )
427.LE..OR..LE.
IF( ANORMIZERO AINVNMZERO ) THEN
430 RCONDI = ( ONE / ANORMI ) / AINVNM
434 DO 50 ITRAN = 1, NTRAN
438 TRANS = TRANSS( ITRAN )
439.EQ.
IF( ITRAN1 ) THEN
447 CALL ZLACPY( 'full
', N, N, ASAV, LDA, A, LDA )
452 CALL ZLARHS( PATH, XTYPE, 'full
', TRANS, N, N, KL,
453 $ KU, NRHS, A, LDA, XACT, LDA, B, LDA,
456 CALL ZLACPY( 'full
', N, NRHS, B, LDA, BSAV, LDA )
458.AND..EQ.
IF( NOFACT ITRAN1 ) THEN
465 CALL ZLACPY( 'full
', N, N, A, LDA, AFAC, LDA )
466 CALL ZLACPY( 'full
', N, NRHS, B, LDA, X, LDA )
469 CALL ZGESV( N, NRHS, AFAC, LDA, IWORK, X, LDA,
475 $ CALL ALAERH( PATH, 'zgesv ', INFO, IZERO,
476 $ ' ', N, N, -1, -1, NRHS, IMAT,
477 $ NFAIL, NERRS, NOUT )
482 CALL ZGET01( N, N, A, LDA, AFAC, LDA, IWORK,
483 $ RWORK, RESULT( 1 ) )
485.EQ.
IF( IZERO0 ) THEN
489 CALL ZLACPY( 'full
', N, NRHS, B, LDA, WORK,
491 CALL ZGET02( 'no transpose
', N, N, NRHS, A,
492 $ LDA, X, LDA, WORK, LDA, RWORK,
497 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
498 $ RCONDC, RESULT( 3 ) )
506.GE.
IF( RESULT( K )THRESH ) THEN
507.EQ..AND..EQ.
IF( NFAIL0 NERRS0 )
508 $ CALL ALADHD( NOUT, PATH )
509 WRITE( NOUT, FMT = 9999 )'zgesv ', N,
510 $ IMAT, K, RESULT( K )
520 $ CALL ZLASET( 'full
', N, N, DCMPLX( ZERO ),
521 $ DCMPLX( ZERO ), AFAC, LDA )
522 CALL ZLASET( 'full
', N, NRHS, DCMPLX( ZERO ),
523 $ DCMPLX( ZERO ), X, LDA )
524.GT..AND..GT.
IF( IEQUED1 N0 ) THEN
529 CALL ZLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
530 $ COLCND, AMAX, EQUED )
537 CALL ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
538 $ LDA, IWORK, EQUED, S, S( N+1 ), B,
539 $ LDA, X, LDA, RCOND, RWORK,
540 $ RWORK( NRHS+1 ), WORK,
541 $ RWORK( 2*NRHS+1 ), INFO )
546 $ CALL ALAERH( PATH, 'zgesvx', INFO, IZERO,
547 $ FACT // TRANS, N, N, -1, -1, NRHS,
548 $ IMAT, NFAIL, NERRS, NOUT )
553.NE..AND..LE.
IF( INFO0 INFON) THEN
554 RPVGRW = ZLANTR( 'm
', 'u
', 'n
', INFO, INFO,
556.EQ.
IF( RPVGRWZERO ) THEN
559 RPVGRW = ZLANGE( 'm
', N, INFO, A, LDA,
563 RPVGRW = ZLANTR( 'm
', 'u
', 'n
', N, N, AFAC, LDA,
565.EQ.
IF( RPVGRWZERO ) THEN
568 RPVGRW = ZLANGE( 'm
', N, N, A, LDA, RDUM ) /
572 RESULT( 7 ) = ABS( RPVGRW-RWORK( 2*NRHS+1 ) ) /
573 $ MAX( RWORK( 2*NRHS+1 ), RPVGRW ) /
576.NOT.
IF( PREFAC ) THEN
581 CALL ZGET01( N, N, A, LDA, AFAC, LDA, IWORK,
582 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
593 CALL ZLACPY( 'full
', N, NRHS, BSAV, LDA, WORK,
595 CALL ZGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
596 $ LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
601.OR..AND.
IF( NOFACT ( PREFAC LSAME( EQUED,
603 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
604 $ RCONDC, RESULT( 3 ) )
606.EQ.
IF( ITRAN1 ) THEN
611 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
612 $ ROLDC, RESULT( 3 ) )
618 CALL ZGET07( TRANS, N, NRHS, ASAV, LDA, B, LDA,
619 $ X, LDA, XACT, LDA, RWORK, .TRUE.,
620 $ RWORK( NRHS+1 ), RESULT( 4 ) )
628 RESULT( 6 ) = DGET06( RCOND, RCONDC )
633.NOT.
IF( TRFCON ) THEN
635.GE.
IF( RESULT( K )THRESH ) THEN
636.EQ..AND..EQ.
IF( NFAIL0 NERRS0 )
637 $ CALL ALADHD( NOUT, PATH )
639 WRITE( NOUT, FMT = 9997 )'zgesvx',
640 $ FACT, TRANS, N, EQUED, IMAT, K,
643 WRITE( NOUT, FMT = 9998 )'zgesvx',
644 $ FACT, TRANS, N, IMAT, K, RESULT( K )
649 NRUN = NRUN + NTESTS - K1 + 1
651.GE..AND..NOT.
IF( RESULT( 1 )THRESH PREFAC )
653.EQ..AND..EQ.
IF( NFAIL0 NERRS0 )
654 $ CALL ALADHD( NOUT, PATH )
656 WRITE( NOUT, FMT = 9997 )'zgesvx', FACT,
657 $ TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
659 WRITE( NOUT, FMT = 9998 )'zgesvx', FACT,
660 $ TRANS, N, IMAT, 1, RESULT( 1 )
665.GE.
IF( RESULT( 6 )THRESH ) THEN
666.EQ..AND..EQ.
IF( NFAIL0 NERRS0 )
667 $ CALL ALADHD( NOUT, PATH )
669 WRITE( NOUT, FMT = 9997 )'zgesvx', FACT,
670 $ TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
672 WRITE( NOUT, FMT = 9998 )'zgesvx', FACT,
673 $ TRANS, N, IMAT, 6, RESULT( 6 )
678.GE.
IF( RESULT( 7 )THRESH ) THEN
679.EQ..AND..EQ.
IF( NFAIL0 NERRS0 )
680 $ CALL ALADHD( NOUT, PATH )
682 WRITE( NOUT, FMT = 9997 )'zgesvx', FACT,
683 $ TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
685 WRITE( NOUT, FMT = 9998 )'zgesvx', FACT,
686 $ TRANS, N, IMAT, 7, RESULT( 7 )
702 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
704 9999 FORMAT( 1X, A, ', n =', i5,
', type ', i2,
', test(', i2,
') =',
706 9998
FORMAT( 1x, a,
', FACT=''', a1, '
'', trans=
''', A1, ''', n=
', I5,
707 $ ',
type ', I2, ', test(
', I1, ')=
', G12.5 )
708 9997 FORMAT( 1X, A, ', fact=
''', A1, ''', trans=
''', A1, ''', n=
', I5,
709 $ ', equed=
''', A1, ''',
type ', I2, ', test(
', I1, ')=
',
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 zlaqge(m, n, a, lda, r, c, rowcnd, colcnd, amax, equed)
ZLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ.
subroutine zgetri(n, a, lda, ipiv, work, lwork, info)
ZGETRI
subroutine zgeequ(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
ZGEEQU
subroutine zgesv(n, nrhs, a, lda, ipiv, b, ldb, info)
ZGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver)
subroutine zgesvx(fact, trans, n, nrhs, a, lda, af, ldaf, ipiv, equed, r, c, b, ldb, x, ldx, rcond, ferr, berr, work, rwork, info)
ZGESVX computes the solution to system of linear equations A * X = B for GE matrices
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zlaset(uplo, m, n, alpha, beta, a, lda)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
subroutine zlarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
ZLARHS
subroutine zget02(trans, m, n, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
ZGET02
subroutine zget07(trans, n, nrhs, a, lda, b, ldb, x, ldx, xact, ldxact, ferr, chkferr, berr, reslts)
ZGET07
subroutine zerrvx(path, nunit)
ZERRVX
subroutine zget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
ZGET04
subroutine zget01(m, n, a, lda, afac, ldafac, ipiv, rwork, resid)
ZGET01
subroutine zdrvge(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, asav, b, bsav, x, xact, s, work, rwork, iwork, nout)
ZDRVGE
subroutine zlatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
ZLATB4
subroutine zlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
ZLATMS
subroutine zgetrf(m, n, a, lda, ipiv, info)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.