161 SUBROUTINE cdrvge( 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
176 INTEGER IWORK( * ), NVAL( * )
177 REAL RWORK( * ), S( * )
178 COMPLEX A( * ), AFAC( * ), ASAV( * ), B( * ),
179 $ bsav( * ), work( * ), x( * ), xact( * )
186 PARAMETER ( ONE = 1.0e+0, zero = 0.0e+0 )
188 parameter( ntypes = 11 )
190 parameter( ntests = 7 )
192 parameter( ntran = 3 )
195 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
196 CHARACTER DIST, , FACT, TRANS,
TYPE, XTYPE
198 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ,
199 $ izero, k, k1, kl, ku, lda, lwork, mode, n, nb,
200 $ nbmin, nerrs, nfact, nfail, nimat, nrun, nt
201 REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM,
202 $ COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC,
203 $ roldi, roldo, rowcnd, rpvgrw
206 CHARACTER EQUEDS( 4 ), ( 3 ), TRANSS( NTRAN )
207 INTEGER ISEED( 4 ), ISEEDY( 4 )
208 REAL RDUM( 1 ), RESULT( NTESTS
212 REAL CLANGE, CLANTR, SGET06,
213 EXTERNAL lsame, clange, clantr, sget06,
slamch
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 ) =
'Complex precision'
249 iseed( i ) = iseedy( i )
255 $
CALL cerrvx( path, nout )
275 DO 80 imat = 1, nimat
279 IF( .NOT.dotype( imat ) )
284 zerot = imat.GE.5 .AND. imat.LE.7
285 IF( zerot .AND. n.LT.imat-4 )
291 CALL clatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
293 rcondc = one / cndnum
296 CALL clatms( n, n, dist, iseed,
TYPE, rwork, mode, cndnum,
297 $ anorm, kl, ku,
'No packing', a, lda, work,
303 CALL alaerh( path, '
clatms', 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 CLASET( 'full
', N, N-IZERO+1, CMPLX( ZERO ),
326 $ CMPLX( ZERO ), A( IOFF+1 ), LDA )
334 CALL CLACPY( '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 CLACPY( 'full
', N, N, ASAV, LDA, AFAC, LDA )
364.OR..GT.
IF( EQUIL IEQUED1 ) THEN
369 CALL CGEEQU( 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 CLAQGE( N, N, AFAC, LDA, S, S( N+1 ),
386 $ ROWCND, COLCND, AMAX, EQUED )
400 ANORMO = CLANGE( '1
', N, N, AFAC, LDA, RWORK )
401 ANORMI = CLANGE( 'i
', N, N, AFAC, LDA, RWORK )
406 CALL CGETRF( N, N, AFAC, LDA, IWORK, INFO )
410 CALL CLACPY( 'full
', N, N, AFAC, LDA, A, LDA )
411 LWORK = NMAX*MAX( 3, NRHS )
413 CALL CGETRI( N, A, LDA, IWORK, WORK, LWORK, INFO )
417 AINVNM = CLANGE( '1
', N, N, A, LDA, RWORK )
418.LE..OR..LE.
IF( ANORMOZERO AINVNMZERO ) THEN
421 RCONDO = ( ONE / ANORMO ) / AINVNM
426 AINVNM = CLANGE( '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 CLACPY( 'full
', N, N, ASAV, LDA, A, LDA )
452 CALL CLARHS( PATH, XTYPE, 'full
', TRANS, N, N, KL,
453 $ KU, NRHS, A, LDA, XACT, LDA, B, LDA,
456 CALL CLACPY( 'full
', N, NRHS, B, LDA, BSAV, LDA )
458.AND..EQ.
IF( NOFACT ITRAN1 ) THEN
465 CALL CLACPY( 'full
', N, N, A, LDA, AFAC, LDA )
466 CALL CLACPY( 'full
', N, NRHS, B, LDA, X, LDA )
469 CALL CGESV( N, NRHS, AFAC, LDA, IWORK, X, LDA,
475 $ CALL ALAERH( PATH, 'cgesv ', INFO, IZERO,
476 $ ' ', N, N, -1, -1, NRHS, IMAT,
477 $ NFAIL, NERRS, NOUT )
482 CALL CGET01( N, N, A, LDA, AFAC, LDA, IWORK,
483 $ RWORK, RESULT( 1 ) )
485.EQ.
IF( IZERO0 ) THEN
489 CALL CLACPY( 'full
', N, NRHS, B, LDA, WORK,
491 CALL CGET02( 'no transpose
', N, N, NRHS, A,
492 $ LDA, X, LDA, WORK, LDA, RWORK,
497 CALL CGET04( 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 )'cgesv ', N,
510 $ IMAT, K, RESULT( K )
520 $ CALL CLASET( 'full
', N, N, CMPLX( ZERO ),
521 $ CMPLX( ZERO ), AFAC, LDA )
522 CALL CLASET( 'full
', N, NRHS, CMPLX( ZERO ),
523 $ CMPLX( ZERO ), X, LDA )
524.GT..AND..GT.
IF( IEQUED1 N0 ) THEN
529 CALL CLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
530 $ COLCND, AMAX, EQUED )
537 CALL CGESVX( 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, 'cgesvx', 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 = CLANTR( 'm
', 'u
', 'n
', INFO, INFO,
556.EQ.
IF( RPVGRWZERO ) THEN
559 RPVGRW = CLANGE( 'm
', N, INFO, A, LDA,
563 RPVGRW = CLANTR( 'm
', 'u',
'N', n, n, afac, lda,
565 IF( rpvgrw.EQ.zero )
THEN
568 rpvgrw = clange(
'M', n, n, a, lda, rdum ) /
572 result( 7 ) = abs( rpvgrw-rwork( 2*nrhs+1 ) ) /
576 IF( .NOT.prefac )
THEN
581 CALL cget01( n, n, a, lda, afac, lda, iwork,
582 $ rwork( 2*nrhs+1 ), result( 1 ) )
593 CALL clacpy(
'Full', n, nrhs, bsav, lda, work,
595 CALL cget02( trans, n, n, nrhs, asav, lda, x,
596 $ lda, work, lda, rwork( 2*nrhs+1 ),
601 IF( nofact .OR. ( prefac .AND. lsame( equed,
603 CALL cget04( n, nrhs, x, lda, xact, lda,
604 $ rcondc, result( 3 ) )
606 IF( itran.EQ.1 )
THEN
611 CALL cget04( n, nrhs, x, lda, xact, lda,
612 $ roldc, result( 3 ) )
618 CALL cget07( trans, n, nrhs, asav, lda, b, lda,
619 $ x, lda, xact, lda, rwork, .true.,
620 $ rwork( nrhs+1 ), result( 4 ) )
628 result( 6 ) = sget06( rcond, rcondc )
633 IF( .NOT.trfcon )
THEN
635 IF( result( k ).GE.thresh )
THEN
636 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
637 $
CALL aladhd( nout, path )
639 WRITE( nout, fmt = 9997 )
'CGESVX',
640 $ fact, trans, n, equed, imat, k,
643 WRITE( nout, fmt = 9998 )
'CGESVX',
644 $ fact, trans, n, imat, k, result( k )
649 nrun = nrun + ntests - k1 + 1
651 IF( result( 1 ).GE.thresh .AND. .NOT.prefac )
653 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
654 $
CALL aladhd( nout, path )
656 WRITE( nout, fmt = 9997 )
'CGESVX', fact,
657 $ trans, n, equed, imat, 1, result( 1 )
659 WRITE( nout, fmt = 9998 )
'CGESVX', fact,
660 $ trans, n, imat, 1, result( 1 )
665 IF( result( 6 ).GE.thresh )
THEN
666 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
667 $
CALL aladhd( nout, path )
669 WRITE( nout, fmt = 9997 )
'CGESVX', fact,
670 $ trans, n, equed, imat, 6, result( 6 )
672 WRITE( nout, fmt = 9998 )
'CGESVX', fact,
673 $ trans, n, imat, 6, result( 6 )
678 IF( result( 7 ).GE.thresh )
THEN
679 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
680 $
CALL aladhd( nout, path )
682 WRITE( nout, fmt = 9997 )
'CGESVX', fact,
683 $ trans, n, equed, imat, 7, result( 7 )
685 WRITE( nout, fmt = 9998 )
'CGESVX', 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 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