166 SUBROUTINE cdrvge( 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
182 INTEGER IWORK( * ), NVAL( * )
183 REAL RWORK( * ), S( * )
184 COMPLEX A( * ), AFAC( * ), ASAV( * ), B( * ),
185 $ bsav( * ), work( * ), x( * ), xact( * )
192 parameter( one = 1.0e+0, zero = 0.0e+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 REAL 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 REAL RDUM( 1 ), RESULT( ntests ), BERR( nrhs ),
216 $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
220 REAL CLANGE, CLANTR, SGET06, SLAMCH, CLA_GERPVGRW
221 EXTERNAL lsame, clange, clantr, sget06, slamch,
231 INTRINSIC abs, cmplx, max
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 ) =
'Complex precision'
258 iseed( i ) = iseedy( i )
264 $ CALL
cerrvx( 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
clatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
302 rcondc = one / cndnum
305 CALL
clatms( n, n, dist, iseed,
TYPE, RWORK, MODE, CNDNUM,
306 $ anorm, kl, ku,
'No packing', a, lda, work,
312 CALL
alaerh( path,
'CLATMS', 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
claset(
'Full', n, n-izero+1, cmplx( zero ),
335 $ cmplx( zero ), a( ioff+1 ), lda )
343 CALL
clacpy(
'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
clacpy(
'Full', n, n, asav, lda, afac, lda )
373 IF( equil .OR. iequed.GT.1 )
THEN
378 CALL
cgeequ( 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
claqge( n, n, afac, lda, s, s( n+1 ),
395 $ rowcnd, colcnd, amax, equed )
409 anormo = clange(
'1', n, n, afac, lda, rwork )
410 anormi = clange(
'I', n, n, afac, lda, rwork )
414 CALL
cgetrf( n, n, afac, lda, iwork, info )
418 CALL
clacpy(
'Full', n, n, afac, lda, a, lda )
419 lwork = nmax*max( 3, nrhs )
420 CALL
cgetri( n, a, lda, iwork, work, lwork, info )
424 ainvnm = clange(
'1', n, n, a, lda, rwork )
425 IF( anormo.LE.zero .OR. ainvnm.LE.zero )
THEN
428 rcondo = ( one / anormo ) / ainvnm
433 ainvnm = clange(
'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
clacpy(
'Full', n, n, asav, lda, a, lda )
459 CALL
clarhs( path, xtype,
'Full', trans, n, n, kl,
460 $ ku, nrhs, a, lda, xact, lda, b, lda,
463 CALL
clacpy(
'Full', n, nrhs, b, lda, bsav, lda )
465 IF( nofact .AND. itran.EQ.1 )
THEN
472 CALL
clacpy(
'Full', n, n, a, lda, afac, lda )
473 CALL
clacpy(
'Full', n, nrhs, b, lda, x, lda )
476 CALL
cgesv( n, nrhs, afac, lda, iwork, x, lda,
482 $ CALL
alaerh( path,
'CGESV ', info, izero,
483 $
' ', n, n, -1, -1, nrhs, imat,
484 $ nfail, nerrs, nout )
489 CALL
cget01( n, n, a, lda, afac, lda, iwork,
490 $ rwork, result( 1 ) )
492 IF( izero.EQ.0 )
THEN
496 CALL
clacpy(
'Full', n, nrhs, b, lda, work,
498 CALL
cget02(
'No transpose', n, n, nrhs, a,
499 $ lda, x, lda, work, lda, rwork,
504 CALL
cget04( 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 )
'CGESV ', n,
517 $ imat, k, result( k )
527 $ CALL
claset(
'Full', n, n, cmplx( zero ),
528 $ cmplx( zero ), afac, lda )
529 CALL
claset(
'Full', n, nrhs, cmplx( zero ),
530 $ cmplx( zero ), x, lda )
531 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
536 CALL
claqge( n, n, a, lda, s, s( n+1 ), rowcnd,
537 $ colcnd, amax, equed )
544 CALL
cgesvx( 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,
'CGESVX', info, izero,
554 $ fact // trans, n, n, -1, -1, nrhs,
555 $ imat, nfail, nerrs, nout )
561 rpvgrw = clantr(
'M',
'U',
'N', info, info,
563 IF( rpvgrw.EQ.zero )
THEN
566 rpvgrw = clange(
'M', n, info, a, lda,
570 rpvgrw = clantr(
'M',
'U',
'N', n, n, afac, lda,
572 IF( rpvgrw.EQ.zero )
THEN
575 rpvgrw = clange(
'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
cget01( n, n, a, lda, afac, lda, iwork,
589 $ rwork( 2*nrhs+1 ), result( 1 ) )
600 CALL
clacpy(
'Full', n, nrhs, bsav, lda, work,
602 CALL
cget02( 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
cget04( n, nrhs, x, lda, xact, lda,
611 $ rcondc, result( 3 ) )
613 IF( itran.EQ.1 )
THEN
618 CALL
cget04( n, nrhs, x, lda, xact, lda,
619 $ roldc, result( 3 ) )
625 CALL
cget07( trans, n, nrhs, asav, lda, b, lda,
626 $ x, lda, xact, lda, rwork, .true.,
627 $ rwork( nrhs+1 ), result( 4 ) )
635 result( 6 ) = sget06( 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 )
'CGESVX',
647 $ fact, trans, n, equed, imat, k,
650 WRITE( nout, fmt = 9998 )
'CGESVX',
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 )
'CGESVX', fact,
664 $ trans, n, equed, imat, 1, result( 1 )
666 WRITE( nout, fmt = 9998 )
'CGESVX', 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 )
'CGESVX', fact,
677 $ trans, n, equed, imat, 6, result( 6 )
679 WRITE( nout, fmt = 9998 )
'CGESVX', 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 )
'CGESVX', fact,
690 $ trans, n, equed, imat, 7, result( 7 )
692 WRITE( nout, fmt = 9998 )
'CGESVX', fact,
693 $ trans, n, imat, 7, result( 7 )
706 CALL
clacpy(
'Full', n, n, asav, lda, a, lda )
707 CALL
clacpy(
'Full', n, nrhs, bsav, lda, b, lda )
710 $ CALL
claset(
'Full', n, n, zero, zero, afac,
712 CALL
claset(
'Full', n, nrhs, zero, zero, x, lda )
713 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
718 CALL
claqge( n, n, a, lda, s, s( n+1 ), rowcnd,
719 $ colcnd, amax, equed )
727 CALL
cgesvxx( 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,
'CGESVXX', 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 = cla_gerpvgrw
749 $ (n, info, a, lda, afac, lda)
751 rpvgrw = cla_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
cget01( n, n, a, lda, afac, lda, iwork,
765 $ rwork( 2*nrhs+1 ), result( 1 ) )
776 CALL
clacpy(
'Full', n, nrhs, bsav, lda, work,
778 CALL
cget02( 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
cget04( n, nrhs, x, lda, xact, lda,
787 $ rcondc, result( 3 ) )
789 IF( itran.EQ.1 )
THEN
794 CALL
cget04( n, nrhs, x, lda, xact, lda,
795 $ roldc, result( 3 ) )
804 result( 6 ) = sget06( 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 )
'CGESVXX',
816 $ fact, trans, n, equed, imat, k,
819 WRITE( nout, fmt = 9998 )
'CGESVXX',
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 )
'CGESVXX', fact,
833 $ trans, n, equed, imat, 1, result( 1 )
835 WRITE( nout, fmt = 9998 )
'CGESVXX', 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 )
'CGESVXX', fact,
846 $ trans, n, equed, imat, 6, result( 6 )
848 WRITE( nout, fmt = 9998 )
'CGESVXX', 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 )
'CGESVXX', fact,
859 $ trans, n, equed, imat, 7, result( 7 )
861 WRITE( nout, fmt = 9998 )
'CGESVXX', 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 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 cget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
CGET01
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine cgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
CGETRI
subroutine claqge(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, EQUED)
CLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ...
subroutine cget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
CGET07
subroutine cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
subroutine cgesvxx(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)
CGESVXX computes the solution to system of linear equations A * X = B for GE matrices ...
subroutine cgesvx(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CGESVX computes the solution to system of linear equations A * X = B for GE 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 clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cgesv(N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver) ...
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine cebchvxx(THRESH, PATH)
CEBCHVXX
subroutine cerrvx(PATH, NUNIT)
CERRVX
subroutine cget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CGET02
subroutine cdrvge(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
CDRVGE
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine cgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
CGEEQU