174 INTEGER nmax, nn, nout, nrhs
175 DOUBLE PRECISION thresh
179 INTEGER iwork( * ), nval( * )
180 DOUBLE PRECISION rwork( * ), s( * )
181 COMPLEX*16 a( * ), afac( * ), asav( * ), b( * ),
182 $ bsav( * ), work( * ), x( * ), xact( * )
188 DOUBLE PRECISION one, zero
189 parameter ( one = 1.0d+0, zero = 0.0d+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 DOUBLE PRECISION 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 DOUBLE PRECISION rdum( 1 ), result( ntests )
225 INTRINSIC abs, dcmplx, 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 ) =
'Zomplex precision'
252 iseed( i ) = iseedy( i )
258 $
CALL zerrvx( 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 zlatb4( path, imat, n, n,
TYPE, kl, ku, anorm, mode,
296 rcondc = one / cndnum
299 CALL zlatms( n, n, dist, iseed,
TYPE, rwork, mode, cndnum,
300 $ anorm, kl, ku,
'No packing', a, lda, work,
306 CALL alaerh( path,
'ZLATMS', 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 zlaset(
'Full', n, n-izero+1, dcmplx( zero ),
329 $ dcmplx( zero ), a( ioff+1 ), lda )
337 CALL zlacpy(
'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 zlacpy(
'Full', n, n, asav, lda, afac, lda )
367 IF( equil .OR. iequed.GT.1 )
THEN
372 CALL zgeequ( 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 zlaqge( n, n, afac, lda, s, s( n+1 ),
389 $ rowcnd, colcnd, amax, equed )
403 anormo =
zlange(
'1', n, n, afac, lda, rwork )
404 anormi =
zlange(
'I', n, n, afac, lda, rwork )
409 CALL zgetrf( n, n, afac, lda, iwork, info )
413 CALL zlacpy(
'Full', n, n, afac, lda, a, lda )
414 lwork = nmax*max( 3, nrhs )
416 CALL zgetri( n, a, lda, iwork, work, lwork, info )
420 ainvnm =
zlange(
'1', n, n, a, lda, rwork )
421 IF( anormo.LE.zero .OR. ainvnm.LE.zero )
THEN
424 rcondo = ( one / anormo ) / ainvnm
429 ainvnm =
zlange(
'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 zlacpy(
'Full', n, n, asav, lda, a, lda )
455 CALL zlarhs( path, xtype,
'Full', trans, n, n, kl,
456 $ ku, nrhs, a, lda, xact, lda, b, lda,
459 CALL zlacpy(
'Full', n, nrhs, b, lda, bsav, lda )
461 IF( nofact .AND. itran.EQ.1 )
THEN
468 CALL zlacpy(
'Full', n, n, a, lda, afac, lda )
469 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
472 CALL zgesv( n, nrhs, afac, lda, iwork, x, lda,
478 $
CALL alaerh( path,
'ZGESV ', info, izero,
479 $
' ', n, n, -1, -1, nrhs, imat,
480 $ nfail, nerrs, nout )
485 CALL zget01( n, n, a, lda, afac, lda, iwork,
486 $ rwork, result( 1 ) )
488 IF( izero.EQ.0 )
THEN
492 CALL zlacpy(
'Full', n, nrhs, b, lda, work,
494 CALL zget02(
'No transpose', n, n, nrhs, a,
495 $ lda, x, lda, work, lda, rwork,
500 CALL zget04( 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 )
'ZGESV ', n,
513 $ imat, k, result( k )
523 $
CALL zlaset(
'Full', n, n, dcmplx( zero ),
524 $ dcmplx( zero ), afac, lda )
525 CALL zlaset(
'Full', n, nrhs, dcmplx( zero ),
526 $ dcmplx( zero ), x, lda )
527 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
532 CALL zlaqge( n, n, a, lda, s, s( n+1 ), rowcnd,
533 $ colcnd, amax, equed )
540 CALL zgesvx( 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,
'ZGESVX', 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 =
zlantr(
'M',
'U',
'N', info, info,
559 IF( rpvgrw.EQ.zero )
THEN
562 rpvgrw =
zlange(
'M', n, info, a, lda,
566 rpvgrw =
zlantr(
'M',
'U',
'N', n, n, afac, lda,
568 IF( rpvgrw.EQ.zero )
THEN
571 rpvgrw =
zlange(
'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 zget01( n, n, a, lda, afac, lda, iwork,
585 $ rwork( 2*nrhs+1 ), result( 1 ) )
596 CALL zlacpy(
'Full', n, nrhs, bsav, lda, work,
598 CALL zget02( 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 zget04( n, nrhs, x, lda, xact, lda,
607 $ rcondc, result( 3 ) )
609 IF( itran.EQ.1 )
THEN
614 CALL zget04( n, nrhs, x, lda, xact, lda,
615 $ roldc, result( 3 ) )
621 CALL zget07( trans, n, nrhs, asav, lda, b, lda,
622 $ x, lda, xact, lda, rwork, .true.,
623 $ rwork( nrhs+1 ), result( 4 ) )
631 result( 6 ) =
dget06( 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 )
'ZGESVX',
643 $ fact, trans, n, equed, imat, k,
646 WRITE( nout, fmt = 9998 )
'ZGESVX',
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 )
'ZGESVX', fact,
660 $ trans, n, equed, imat, 1, result( 1 )
662 WRITE( nout, fmt = 9998 )
'ZGESVX', 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 )
'ZGESVX', fact,
673 $ trans, n, equed, imat, 6, result( 6 )
675 WRITE( nout, fmt = 9998 )
'ZGESVX', 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 )
'ZGESVX', fact,
686 $ trans, n, equed, imat, 7, result( 7 )
688 WRITE( nout, fmt = 9998 )
'ZGESVX', 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 alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
double precision function dlamch(CMACH)
DLAMCH
double precision function zlantr(NORM, UPLO, DIAG, M, N, A, LDA, WORK)
ZLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix.
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
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 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 xlaenv(ISPEC, NVALUE)
XLAENV
subroutine zget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
ZGET07
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
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 aladhd(IOUNIT, PATH)
ALADHD
subroutine zgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
ZGETRI
double precision function dget06(RCOND, RCONDC)
DGET06
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQU
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 zget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
ZGET01
subroutine zget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET02
logical function lsame(CA, CB)
LSAME