163 SUBROUTINE cdrvge( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
164 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
165 $ RWORK, IWORK, NOUT )
174 INTEGER NMAX, NN, NOUT, NRHS
179 INTEGER IWORK( * ), NVAL( * )
180 REAL RWORK( * ), S( * )
181 COMPLEX A( * ), AFAC( * ), ASAV( * ), B( * ),
182 $ bsav( * ), work( * ), x( * ), xact( * )
189 parameter( one = 1.0e+0, zero = 0.0e+0 )
191 parameter( ntypes = 11 )
193 parameter( ntests = 7 )
195 parameter( ntran = 3 )
198 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
199 CHARACTER DIST, EQUED, FACT, TRANS,
TYPE, XTYPE
201 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN,
202 $ izero, k, k1, kl, ku, lda, lwork, mode, n, nb,
203 $ nbmin, nerrs, nfact, nfail, nimat, nrun, nt
204 REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM,
205 $ colcnd, rcond, rcondc, rcondi, rcondo, roldc,
206 $ roldi, roldo, rowcnd, rpvgrw
209 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( ntran )
210 INTEGER ISEED( 4 ), ISEEDY( 4 )
211 REAL RDUM( 1 ), RESULT( ntests )
215 REAL CLANGE, CLANTR, SGET06, SLAMCH
216 EXTERNAL lsame, clange, clantr, sget06, slamch
225 INTRINSIC abs, cmplx, max
233 COMMON / infoc / infot, nunit, ok, lerr
234 COMMON / srnamc / srnamt
237 DATA iseedy / 1988, 1989, 1990, 1991 /
238 DATA transs /
'N',
'T',
'C' /
239 DATA facts /
'F',
'N',
'E' /
240 DATA equeds /
'N',
'R',
'C',
'B' /
246 path( 1: 1 ) =
'Complex precision' 252 iseed( i ) = iseedy( i )
258 $
CALL cerrvx( path, nout )
278 DO 80 imat = 1, nimat
282 IF( .NOT.dotype( imat ) )
287 zerot = imat.GE.5 .AND. imat.LE.7
288 IF( zerot .AND. n.LT.imat-4 )
294 CALL clatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
296 rcondc = one / cndnum
299 CALL clatms( n, n, dist, iseed,
TYPE, RWORK, MODE, CNDNUM,
300 $ anorm, kl, ku,
'No packing', a, lda, work,
306 CALL alaerh( path,
'CLATMS', info, 0,
' ', n, n, -1, -1,
307 $ -1, imat, nfail, nerrs, nout )
317 ELSE IF( imat.EQ.6 )
THEN 322 ioff = ( izero-1 )*lda
328 CALL claset(
'Full', n, n-izero+1, cmplx( zero ),
329 $ cmplx( zero ), a( ioff+1 ), lda )
337 CALL clacpy(
'Full', n, n, a, lda, asav, lda )
340 equed = equeds( iequed )
341 IF( iequed.EQ.1 )
THEN 347 DO 60 ifact = 1, nfact
348 fact = facts( ifact )
349 prefac = lsame( fact,
'F' )
350 nofact = lsame( fact,
'N' )
351 equil = lsame( fact,
'E' )
359 ELSE IF( .NOT.nofact )
THEN 366 CALL clacpy(
'Full', n, n, asav, lda, afac, lda )
367 IF( equil .OR. iequed.GT.1 )
THEN 372 CALL cgeequ( n, n, afac, lda, s, s( n+1 ),
373 $ rowcnd, colcnd, amax, info )
374 IF( info.EQ.0 .AND. n.GT.0 )
THEN 375 IF( lsame( equed,
'R' ) )
THEN 378 ELSE IF( lsame( equed,
'C' ) )
THEN 381 ELSE IF( lsame( equed,
'B' ) )
THEN 388 CALL claqge( n, n, afac, lda, s, s( n+1 ),
389 $ rowcnd, colcnd, amax, equed )
403 anormo = clange(
'1', n, n, afac, lda, rwork )
404 anormi = clange(
'I', n, n, afac, lda, rwork )
409 CALL cgetrf( n, n, afac, lda, iwork, info )
413 CALL clacpy(
'Full', n, n, afac, lda, a, lda )
414 lwork = nmax*max( 3, nrhs )
416 CALL cgetri( n, a, lda, iwork, work, lwork, info )
420 ainvnm = clange(
'1', n, n, a, lda, rwork )
421 IF( anormo.LE.zero .OR. ainvnm.LE.zero )
THEN 424 rcondo = ( one / anormo ) / ainvnm
429 ainvnm = clange(
'I', n, n, a, lda, rwork )
430 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN 433 rcondi = ( one / anormi ) / ainvnm
437 DO 50 itran = 1, ntran
441 trans = transs( itran )
442 IF( itran.EQ.1 )
THEN 450 CALL clacpy(
'Full', n, n, asav, lda, a, lda )
455 CALL clarhs( path, xtype,
'Full', trans, n, n, kl,
456 $ ku, nrhs, a, lda, xact, lda, b, lda,
459 CALL clacpy(
'Full', n, nrhs, b, lda, bsav, lda )
461 IF( nofact .AND. itran.EQ.1 )
THEN 468 CALL clacpy(
'Full', n, n, a, lda, afac, lda )
469 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
472 CALL cgesv( n, nrhs, afac, lda, iwork, x, lda,
478 $
CALL alaerh( path,
'CGESV ', info, izero,
479 $
' ', n, n, -1, -1, nrhs, imat,
480 $ nfail, nerrs, nout )
485 CALL cget01( n, n, a, lda, afac, lda, iwork,
486 $ rwork, result( 1 ) )
488 IF( izero.EQ.0 )
THEN 492 CALL clacpy(
'Full', n, nrhs, b, lda, work,
494 CALL cget02(
'No transpose', n, n, nrhs, a,
495 $ lda, x, lda, work, lda, rwork,
500 CALL cget04( n, nrhs, x, lda, xact, lda,
501 $ rcondc, result( 3 ) )
509 IF( result( k ).GE.thresh )
THEN 510 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
511 $
CALL aladhd( nout, path )
512 WRITE( nout, fmt = 9999 )
'CGESV ', n,
513 $ imat, k, result( k )
523 $
CALL claset(
'Full', n, n, cmplx( zero ),
524 $ cmplx( zero ), afac, lda )
525 CALL claset(
'Full', n, nrhs, cmplx( zero ),
526 $ cmplx( zero ), x, lda )
527 IF( iequed.GT.1 .AND. n.GT.0 )
THEN 532 CALL claqge( n, n, a, lda, s, s( n+1 ), rowcnd,
533 $ colcnd, amax, equed )
540 CALL cgesvx( fact, trans, n, nrhs, a, lda, afac,
541 $ lda, iwork, equed, s, s( n+1 ), b,
542 $ lda, x, lda, rcond, rwork,
543 $ rwork( nrhs+1 ), work,
544 $ rwork( 2*nrhs+1 ), info )
549 $
CALL alaerh( path,
'CGESVX', info, izero,
550 $ fact // trans, n, n, -1, -1, nrhs,
551 $ imat, nfail, nerrs, nout )
556 IF( info.NE.0 .AND. info.LE.n)
THEN 557 rpvgrw = clantr(
'M',
'U',
'N', info, info,
559 IF( rpvgrw.EQ.zero )
THEN 562 rpvgrw = clange(
'M', n, info, a, lda,
566 rpvgrw = clantr(
'M',
'U',
'N', n, n, afac, lda,
568 IF( rpvgrw.EQ.zero )
THEN 571 rpvgrw = clange(
'M', n, n, a, lda, rdum ) /
575 result( 7 ) = abs( rpvgrw-rwork( 2*nrhs+1 ) ) /
576 $ max( rwork( 2*nrhs+1 ), rpvgrw ) /
579 IF( .NOT.prefac )
THEN 584 CALL cget01( n, n, a, lda, afac, lda, iwork,
585 $ rwork( 2*nrhs+1 ), result( 1 ) )
596 CALL clacpy(
'Full', n, nrhs, bsav, lda, work,
598 CALL cget02( trans, n, n, nrhs, asav, lda, x,
599 $ lda, work, lda, rwork( 2*nrhs+1 ),
604 IF( nofact .OR. ( prefac .AND. lsame( equed,
606 CALL cget04( n, nrhs, x, lda, xact, lda,
607 $ rcondc, result( 3 ) )
609 IF( itran.EQ.1 )
THEN 614 CALL cget04( n, nrhs, x, lda, xact, lda,
615 $ roldc, result( 3 ) )
621 CALL cget07( trans, n, nrhs, asav, lda, b, lda,
622 $ x, lda, xact, lda, rwork, .true.,
623 $ rwork( nrhs+1 ), result( 4 ) )
631 result( 6 ) = sget06( rcond, rcondc )
636 IF( .NOT.trfcon )
THEN 638 IF( result( k ).GE.thresh )
THEN 639 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
640 $
CALL aladhd( nout, path )
642 WRITE( nout, fmt = 9997 )
'CGESVX',
643 $ fact, trans, n, equed, imat, k,
646 WRITE( nout, fmt = 9998 )
'CGESVX',
647 $ fact, trans, n, imat, k, result( k )
652 nrun = nrun + ntests - k1 + 1
654 IF( result( 1 ).GE.thresh .AND. .NOT.prefac )
656 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
657 $
CALL aladhd( nout, path )
659 WRITE( nout, fmt = 9997 )
'CGESVX', fact,
660 $ trans, n, equed, imat, 1, result( 1 )
662 WRITE( nout, fmt = 9998 )
'CGESVX', fact,
663 $ trans, n, imat, 1, result( 1 )
668 IF( result( 6 ).GE.thresh )
THEN 669 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
670 $
CALL aladhd( nout, path )
672 WRITE( nout, fmt = 9997 )
'CGESVX', fact,
673 $ trans, n, equed, imat, 6, result( 6 )
675 WRITE( nout, fmt = 9998 )
'CGESVX', fact,
676 $ trans, n, imat, 6, result( 6 )
681 IF( result( 7 ).GE.thresh )
THEN 682 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
683 $
CALL aladhd( nout, path )
685 WRITE( nout, fmt = 9997 )
'CGESVX', fact,
686 $ trans, n, equed, imat, 7, result( 7 )
688 WRITE( nout, fmt = 9998 )
'CGESVX', fact,
689 $ trans, n, imat, 7, result( 7 )
705 CALL alasvm( path, nout, nfail, nrun, nerrs )
707 9999
FORMAT( 1x, a,
', N =', i5,
', type ', i2,
', test(', i2,
') =',
709 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', TRANS=''', a1,
''', N=', i5,
710 $
', type ', i2,
', test(', i1,
')=', g12.5 )
711 9997
FORMAT( 1x, a,
', FACT=''', a1,
''', TRANS=''', a1,
''', N=', i5,
712 $
', EQUED=''', a1,
''', type ', i2,
', test(', i1,
')=',
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine cget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
CGET01
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 cgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
CGETRI
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
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 cerrvx(PATH, NUNIT)
CERRVX
subroutine cget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
CGET07
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cdrvge(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
CDRVGE
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 cget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CGET02
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine cgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
CGEEQU
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 clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4