166 SUBROUTINE zdrvge( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
167 $ a, afac, asav, b, bsav, x, xact, s, work,
168 $ rwork, iwork, nout )
177 INTEGER NMAX, NN, NOUT, NRHS
178 DOUBLE PRECISION THRESH
182 INTEGER IWORK( * ), NVAL( * )
183 DOUBLE PRECISION RWORK( * ), S( * )
184 COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
185 $ bsav( * ), work( * ), x( * ), xact( * )
191 DOUBLE PRECISION ONE, ZERO
192 parameter( one = 1.0d+0, zero = 0.0d+0 )
194 parameter( ntypes = 11 )
196 parameter( ntests = 7 )
198 parameter( ntran = 3 )
201 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
202 CHARACTER DIST, EQUED, FACT, TRANS,
TYPE, XTYPE
204 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN,
205 $ izero, k, k1, kl, ku, lda, lwork, mode, n, nb,
206 $ nbmin, nerrs, nfact, nfail, nimat, nrun, nt,
208 DOUBLE PRECISION AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM,
209 $ colcnd, rcond, rcondc, rcondi, rcondo, roldc,
210 $ roldi, roldo, rowcnd, rpvgrw, rpvgrw_svxx
213 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( ntran )
214 INTEGER ISEED( 4 ), ISEEDY( 4 )
215 DOUBLE PRECISION RDUM( 1 ), RESULT( ntests ), BERR( nrhs ),
216 $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
220 DOUBLE PRECISION DGET06, DLAMCH, ZLANGE, ZLANTR, ZLA_GERPVGRW
221 EXTERNAL lsame, dget06, dlamch, zlange, zlantr,
231 INTRINSIC abs, dcmplx, max, dble, dimag
239 COMMON / infoc / infot, nunit, ok, lerr
240 COMMON / srnamc / srnamt
243 DATA iseedy / 1988, 1989, 1990, 1991 /
244 DATA transs /
'N',
'T',
'C' /
245 DATA facts /
'F',
'N',
'E' /
246 DATA equeds /
'N',
'R',
'C',
'B' /
252 path( 1: 1 ) =
'Zomplex precision'
258 iseed( i ) = iseedy( i )
264 $ CALL
zerrvx( path, nout )
284 DO 80 imat = 1, nimat
288 IF( .NOT.dotype( imat ) )
293 zerot = imat.GE.5 .AND. imat.LE.7
294 IF( zerot .AND. n.LT.imat-4 )
300 CALL
zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
302 rcondc = one / cndnum
305 CALL
zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE, CNDNUM,
306 $ anorm, kl, ku,
'No packing', a, lda, work,
312 CALL
alaerh( path,
'ZLATMS', info, 0,
' ', n, n, -1, -1,
313 $ -1, imat, nfail, nerrs, nout )
323 ELSE IF( imat.EQ.6 )
THEN
328 ioff = ( izero-1 )*lda
334 CALL
zlaset(
'Full', n, n-izero+1, dcmplx( zero ),
335 $ dcmplx( zero ), a( ioff+1 ), lda )
343 CALL
zlacpy(
'Full', n, n, a, lda, asav, lda )
346 equed = equeds( iequed )
347 IF( iequed.EQ.1 )
THEN
353 DO 60 ifact = 1, nfact
354 fact = facts( ifact )
355 prefac = lsame( fact,
'F' )
356 nofact = lsame( fact,
'N' )
357 equil = lsame( fact,
'E' )
365 ELSE IF( .NOT.nofact )
THEN
372 CALL
zlacpy(
'Full', n, n, asav, lda, afac, lda )
373 IF( equil .OR. iequed.GT.1 )
THEN
378 CALL
zgeequ( n, n, afac, lda, s, s( n+1 ),
379 $ rowcnd, colcnd, amax, info )
380 IF( info.EQ.0 .AND. n.GT.0 )
THEN
381 IF( lsame( equed,
'R' ) )
THEN
384 ELSE IF( lsame( equed,
'C' ) )
THEN
387 ELSE IF( lsame( equed,
'B' ) )
THEN
394 CALL
zlaqge( n, n, afac, lda, s, s( n+1 ),
395 $ rowcnd, colcnd, amax, equed )
409 anormo = zlange(
'1', n, n, afac, lda, rwork )
410 anormi = zlange(
'I', n, n, afac, lda, rwork )
414 CALL
zgetrf( n, n, afac, lda, iwork, info )
418 CALL
zlacpy(
'Full', n, n, afac, lda, a, lda )
419 lwork = nmax*max( 3, nrhs )
420 CALL
zgetri( n, a, lda, iwork, work, lwork, info )
424 ainvnm = zlange(
'1', n, n, a, lda, rwork )
425 IF( anormo.LE.zero .OR. ainvnm.LE.zero )
THEN
428 rcondo = ( one / anormo ) / ainvnm
433 ainvnm = zlange(
'I', n, n, a, lda, rwork )
434 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN
437 rcondi = ( one / anormi ) / ainvnm
441 DO 50 itran = 1, ntran
445 trans = transs( itran )
446 IF( itran.EQ.1 )
THEN
454 CALL
zlacpy(
'Full', n, n, asav, lda, a, lda )
459 CALL
zlarhs( path, xtype,
'Full', trans, n, n, kl,
460 $ ku, nrhs, a, lda, xact, lda, b, lda,
463 CALL
zlacpy(
'Full', n, nrhs, b, lda, bsav, lda )
465 IF( nofact .AND. itran.EQ.1 )
THEN
472 CALL
zlacpy(
'Full', n, n, a, lda, afac, lda )
473 CALL
zlacpy(
'Full', n, nrhs, b, lda, x, lda )
476 CALL
zgesv( n, nrhs, afac, lda, iwork, x, lda,
482 $ CALL
alaerh( path,
'ZGESV ', info, izero,
483 $
' ', n, n, -1, -1, nrhs, imat,
484 $ nfail, nerrs, nout )
489 CALL
zget01( n, n, a, lda, afac, lda, iwork,
490 $ rwork, result( 1 ) )
492 IF( izero.EQ.0 )
THEN
496 CALL
zlacpy(
'Full', n, nrhs, b, lda, work,
498 CALL
zget02(
'No transpose', n, n, nrhs, a,
499 $ lda, x, lda, work, lda, rwork,
504 CALL
zget04( n, nrhs, x, lda, xact, lda,
505 $ rcondc, result( 3 ) )
513 IF( result( k ).GE.thresh )
THEN
514 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
515 $ CALL
aladhd( nout, path )
516 WRITE( nout, fmt = 9999 )
'ZGESV ', n,
517 $ imat, k, result( k )
527 $ CALL
zlaset(
'Full', n, n, dcmplx( zero ),
528 $ dcmplx( zero ), afac, lda )
529 CALL
zlaset(
'Full', n, nrhs, dcmplx( zero ),
530 $ dcmplx( zero ), x, lda )
531 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
536 CALL
zlaqge( n, n, a, lda, s, s( n+1 ), rowcnd,
537 $ colcnd, amax, equed )
544 CALL
zgesvx( fact, trans, n, nrhs, a, lda, afac,
545 $ lda, iwork, equed, s, s( n+1 ), b,
546 $ lda, x, lda, rcond, rwork,
547 $ rwork( nrhs+1 ), work,
548 $ rwork( 2*nrhs+1 ), info )
553 $ CALL
alaerh( path,
'ZGESVX', info, izero,
554 $ fact // trans, n, n, -1, -1, nrhs,
555 $ imat, nfail, nerrs, nout )
561 rpvgrw = zlantr(
'M',
'U',
'N', info, info,
563 IF( rpvgrw.EQ.zero )
THEN
566 rpvgrw = zlange(
'M', n, info, a, lda,
570 rpvgrw = zlantr(
'M',
'U',
'N', n, n, afac, lda,
572 IF( rpvgrw.EQ.zero )
THEN
575 rpvgrw = zlange(
'M', n, n, a, lda, rdum ) /
579 result( 7 ) = abs( rpvgrw-rwork( 2*nrhs+1 ) ) /
580 $ max( rwork( 2*nrhs+1 ), rpvgrw ) /
583 IF( .NOT.prefac )
THEN
588 CALL
zget01( n, n, a, lda, afac, lda, iwork,
589 $ rwork( 2*nrhs+1 ), result( 1 ) )
600 CALL
zlacpy(
'Full', n, nrhs, bsav, lda, work,
602 CALL
zget02( trans, n, n, nrhs, asav, lda, x,
603 $ lda, work, lda, rwork( 2*nrhs+1 ),
608 IF( nofact .OR. ( prefac .AND. lsame( equed,
610 CALL
zget04( n, nrhs, x, lda, xact, lda,
611 $ rcondc, result( 3 ) )
613 IF( itran.EQ.1 )
THEN
618 CALL
zget04( n, nrhs, x, lda, xact, lda,
619 $ roldc, result( 3 ) )
625 CALL
zget07( trans, n, nrhs, asav, lda, b, lda,
626 $ x, lda, xact, lda, rwork, .true.,
627 $ rwork( nrhs+1 ), result( 4 ) )
635 result( 6 ) = dget06( rcond, rcondc )
640 IF( .NOT.trfcon )
THEN
642 IF( result( k ).GE.thresh )
THEN
643 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
644 $ CALL
aladhd( nout, path )
646 WRITE( nout, fmt = 9997 )
'ZGESVX',
647 $ fact, trans, n, equed, imat, k,
650 WRITE( nout, fmt = 9998 )
'ZGESVX',
651 $ fact, trans, n, imat, k, result( k )
658 IF( result( 1 ).GE.thresh .AND. .NOT.prefac )
660 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
661 $ CALL
aladhd( nout, path )
663 WRITE( nout, fmt = 9997 )
'ZGESVX', fact,
664 $ trans, n, equed, imat, 1, result( 1 )
666 WRITE( nout, fmt = 9998 )
'ZGESVX', fact,
667 $ trans, n, imat, 1, result( 1 )
672 IF( result( 6 ).GE.thresh )
THEN
673 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
674 $ CALL
aladhd( nout, path )
676 WRITE( nout, fmt = 9997 )
'ZGESVX', fact,
677 $ trans, n, equed, imat, 6, result( 6 )
679 WRITE( nout, fmt = 9998 )
'ZGESVX', fact,
680 $ trans, n, imat, 6, result( 6 )
685 IF( result( 7 ).GE.thresh )
THEN
686 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
687 $ CALL
aladhd( nout, path )
689 WRITE( nout, fmt = 9997 )
'ZGESVX', fact,
690 $ trans, n, equed, imat, 7, result( 7 )
692 WRITE( nout, fmt = 9998 )
'ZGESVX', fact,
693 $ trans, n, imat, 7, result( 7 )
706 CALL
zlacpy(
'Full', n, n, asav, lda, a, lda )
707 CALL
zlacpy(
'Full', n, nrhs, bsav, lda, b, lda )
710 $ CALL
zlaset(
'Full', n, n, zero, zero, afac,
712 CALL
zlaset(
'Full', n, nrhs, zero, zero, x, lda )
713 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
718 CALL
zlaqge( n, n, a, lda, s, s( n+1 ), rowcnd,
719 $ colcnd, amax, equed )
727 CALL
zgesvxx( fact, trans, n, nrhs, a, lda, afac,
728 $ lda, iwork, equed, s, s( n+1 ), b, lda, x,
729 $ lda, rcond, rpvgrw_svxx, berr, n_err_bnds,
730 $ errbnds_n, errbnds_c, 0, zero, work,
735 IF( info.EQ.n+1 ) goto 50
736 IF( info.NE.izero )
THEN
737 CALL
alaerh( path,
'ZGESVXX', info, izero,
738 $ fact // trans, n, n, -1, -1, nrhs,
739 $ imat, nfail, nerrs, nout )
747 IF ( info .GT. 0 .AND. info .LT. n+1 )
THEN
748 rpvgrw = zla_gerpvgrw
749 $ (n, info, a, lda, afac, lda)
751 rpvgrw = zla_gerpvgrw
752 $ (n, n, a, lda, afac, lda)
755 result( 7 ) = abs( rpvgrw-rpvgrw_svxx ) /
756 $ max( rpvgrw_svxx, rpvgrw ) /
759 IF( .NOT.prefac )
THEN
764 CALL
zget01( n, n, a, lda, afac, lda, iwork,
765 $ rwork( 2*nrhs+1 ), result( 1 ) )
776 CALL
zlacpy(
'Full', n, nrhs, bsav, lda, work,
778 CALL
zget02( trans, n, n, nrhs, asav, lda, x,
779 $ lda, work, lda, rwork( 2*nrhs+1 ),
784 IF( nofact .OR. ( prefac .AND. lsame( equed,
786 CALL
zget04( n, nrhs, x, lda, xact, lda,
787 $ rcondc, result( 3 ) )
789 IF( itran.EQ.1 )
THEN
794 CALL
zget04( n, nrhs, x, lda, xact, lda,
795 $ roldc, result( 3 ) )
804 result( 6 ) = dget06( rcond, rcondc )
809 IF( .NOT.trfcon )
THEN
811 IF( result( k ).GE.thresh )
THEN
812 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
813 $ CALL
aladhd( nout, path )
815 WRITE( nout, fmt = 9997 )
'ZGESVXX',
816 $ fact, trans, n, equed, imat, k,
819 WRITE( nout, fmt = 9998 )
'ZGESVXX',
820 $ fact, trans, n, imat, k, result( k )
827 IF( result( 1 ).GE.thresh .AND. .NOT.prefac )
829 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
830 $ CALL
aladhd( nout, path )
832 WRITE( nout, fmt = 9997 )
'ZGESVXX', fact,
833 $ trans, n, equed, imat, 1, result( 1 )
835 WRITE( nout, fmt = 9998 )
'ZGESVXX', fact,
836 $ trans, n, imat, 1, result( 1 )
841 IF( result( 6 ).GE.thresh )
THEN
842 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
843 $ CALL
aladhd( nout, path )
845 WRITE( nout, fmt = 9997 )
'ZGESVXX', fact,
846 $ trans, n, equed, imat, 6, result( 6 )
848 WRITE( nout, fmt = 9998 )
'ZGESVXX', fact,
849 $ trans, n, imat, 6, result( 6 )
854 IF( result( 7 ).GE.thresh )
THEN
855 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
856 $ CALL
aladhd( nout, path )
858 WRITE( nout, fmt = 9997 )
'ZGESVXX', fact,
859 $ trans, n, equed, imat, 7, result( 7 )
861 WRITE( nout, fmt = 9998 )
'ZGESVXX', fact,
862 $ trans, n, imat, 7, result( 7 )
878 CALL
alasvm( path, nout, nfail, nrun, nerrs )
885 9999
FORMAT( 1x, a,
', N =', i5,
', type ', i2,
', test(', i2,
') =',
887 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', TRANS=''', a1,
''', N=', i5,
888 $
', type ', i2,
', test(', i1,
')=', g12.5 )
889 9997
FORMAT( 1x, a,
', FACT=''', a1,
''', TRANS=''', a1,
''', N=', i5,
890 $
', EQUED=''', a1,
''', type ', i2,
', test(', i1,
')=',
subroutine zebchvxx(THRESH, PATH)
ZEBCHVXX
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
ZGET01
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
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 zget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
ZGET07
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
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 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 zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
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 zgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
ZGETRI
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zgesvxx(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, INFO)
ZGESVXX computes the solution to system of linear equations A * X = B for GE matrices ...
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET02
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