185 SUBROUTINE zchkge( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
186 $ nsval, thresh, tsterr, nmax, a, afac, ainv,
b,
187 $ x, xact, work, rwork, iwork, nout )
196 INTEGER nm, nmax, nn, nnb, nns, nout
197 DOUBLE PRECISION thresh
201 INTEGER iwork( * ), mval( * ), nbval( * ), nsval( * ),
203 DOUBLE PRECISION rwork( * )
204 COMPLEX*16 a( * ), afac( * ), ainv( * ),
b( * ),
205 $ work( * ), x( * ), xact( * )
211 DOUBLE PRECISION one, zero
212 parameter( one = 1.0d+0, zero = 0.0d+0 )
214 parameter( ntypes = 11 )
216 parameter( ntests = 8 )
218 parameter( ntran = 3 )
221 LOGICAL trfcon, zerot
222 CHARACTER dist, norm, trans, type, xtype
224 INTEGER i, im, imat, in, inb, info, ioff, irhs, itran,
225 $ izero, k, kl, ku, lda, lwork, m, mode, n, nb,
226 $ nerrs, nfail, nimat, nrhs, nrun, nt
227 DOUBLE PRECISION ainvnm, anorm, anormi, anormo, cndnum, dummy,
228 $ rcond, rcondc, rcondi, rcondo
231 CHARACTER transs( ntran )
232 INTEGER iseed( 4 ), iseedy( 4 )
233 DOUBLE PRECISION result( ntests )
246 INTRINSIC dcmplx, max, min
254 COMMON / infoc / infot, nunit, ok, lerr
255 COMMON / srnamc / srnamt
258 DATA iseedy / 1988, 1989, 1990, 1991 / ,
259 $ transs /
'N',
'T',
'C' /
265 path( 1: 1 ) =
'Zomplex precision'
271 iseed( i ) = iseedy( i )
278 $ CALL
zerrge( path, nout )
294 IF( m.LE.0 .OR. n.LE.0 )
297 DO 100 imat = 1, nimat
301 IF( .NOT.dotype( imat ) )
306 zerot = imat.GE.5 .AND. imat.LE.7
307 IF( zerot .AND. n.LT.imat-4 )
313 CALL
zlatb4( path, imat, m, n, type, kl, ku, anorm, mode,
317 CALL
zlatms( m, n, dist, iseed, type, rwork, mode,
318 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
324 CALL
alaerh( path,
'ZLATMS', info, 0,
' ', m, n, -1,
325 $ -1, -1, imat, nfail, nerrs, nout )
335 ELSE IF( imat.EQ.6 )
THEN
338 izero = min( m, n ) / 2 + 1
340 ioff = ( izero-1 )*lda
346 CALL
zlaset(
'Full', m, n-izero+1, dcmplx( zero ),
347 $ dcmplx( zero ), a( ioff+1 ), lda )
367 CALL
zlacpy(
'Full', m, n, a, lda, afac, lda )
369 CALL
zgetrf( m, n, afac, lda, iwork, info )
374 $ CALL
alaerh( path,
'ZGETRF', info, izero,
' ', m,
375 $ n, -1, -1, nb, imat, nfail, nerrs,
382 CALL
zlacpy(
'Full', m, n, afac, lda, ainv, lda )
383 CALL
zget01( m, n, a, lda, ainv, lda, iwork, rwork,
391 IF( m.EQ.n .AND. info.EQ.0 )
THEN
392 CALL
zlacpy(
'Full', n, n, afac, lda, ainv, lda )
395 lwork = nmax*max( 3, nrhs )
396 CALL
zgetri( n, ainv, lda, iwork, work, lwork,
402 $ CALL
alaerh( path,
'ZGETRI', info, 0,
' ', n, n,
403 $ -1, -1, nb, imat, nfail, nerrs,
410 CALL
zget03( n, a, lda, ainv, lda, work, lda,
411 $ rwork, rcondo, result( 2 ) )
412 anormo =
zlange(
'O', m, n, a, lda, rwork )
416 anormi =
zlange(
'I', m, n, a, lda, rwork )
417 ainvnm =
zlange(
'I', n, n, ainv, lda, rwork )
418 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN
421 rcondi = ( one / anormi ) / ainvnm
429 anormo =
zlange(
'O', m, n, a, lda, rwork )
430 anormi =
zlange(
'I', m, n, a, lda, rwork )
439 IF( result( k ).GE.thresh )
THEN
440 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
441 $ CALL
alahd( nout, path )
442 WRITE( nout, fmt = 9999 )m, n, nb, imat, k,
453 IF( inb.GT.1 .OR. m.NE.n )
462 DO 50 itran = 1, ntran
463 trans = transs( itran )
464 IF( itran.EQ.1 )
THEN
474 CALL
zlarhs( path, xtype,
' ', trans, n, n, kl,
475 $ ku, nrhs, a, lda, xact, lda,
b,
479 CALL
zlacpy(
'Full', n, nrhs,
b, lda, x, lda )
481 CALL
zgetrs( trans, n, nrhs, afac, lda, iwork,
487 $ CALL
alaerh( path,
'ZGETRS', info, 0, trans,
488 $ n, n, -1, -1, nrhs, imat, nfail,
491 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work,
493 CALL
zget02( trans, n, n, nrhs, a, lda, x, lda,
494 $ work, lda, rwork, result( 3 ) )
499 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
507 CALL
zgerfs( trans, n, nrhs, a, lda, afac, lda,
508 $ iwork,
b, lda, x, lda, rwork,
509 $ rwork( nrhs+1 ), work,
510 $ rwork( 2*nrhs+1 ), info )
515 $ CALL
alaerh( path,
'ZGERFS', info, 0, trans,
516 $ n, n, -1, -1, nrhs, imat, nfail,
519 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
521 CALL
zget07( trans, n, nrhs, a, lda,
b, lda, x,
522 $ lda, xact, lda, rwork, .true.,
523 $ rwork( nrhs+1 ), result( 6 ) )
529 IF( result( k ).GE.thresh )
THEN
530 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
531 $ CALL
alahd( nout, path )
532 WRITE( nout, fmt = 9998 )trans, n, nrhs,
533 $ imat, k, result( k )
546 IF( itran.EQ.1 )
THEN
556 CALL
zgecon( norm, n, afac, lda, anorm, rcond,
557 $ work, rwork, info )
562 $ CALL
alaerh( path,
'ZGECON', info, 0, norm, n,
563 $ n, -1, -1, -1, imat, nfail, nerrs,
570 result( 8 ) =
dget06( rcond, rcondc )
575 IF( result( 8 ).GE.thresh )
THEN
576 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
577 $ CALL
alahd( nout, path )
578 WRITE( nout, fmt = 9997 )norm, n, imat, 8,
592 CALL
alasum( path, nout, nfail, nrun, nerrs )
594 9999
FORMAT(
' M = ', i5,
', N =', i5,
', NB =', i4,
', type ', i2,
595 $
', test(', i2,
') =', g12.5 )
596 9998
FORMAT(
' TRANS=''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
597 $ i2,
', test(', i2,
') =', g12.5 )
598 9997
FORMAT(
' NORM =''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
599 $
', test(', i2,
') =', g12.5 )
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
ZGET01
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZGECON
subroutine zget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
ZGET07
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGERFS
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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 alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine zgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
ZGETRI
double precision function dget06(RCOND, RCONDC)
DGET06
subroutine zerrge(PATH, NUNIT)
ZERRGE
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
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 zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zget03(N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZGET03
subroutine zget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET02
subroutine zchkge(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZCHKGE
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4