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 )
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 )
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,
')=',