185 SUBROUTINE cchkge( 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
201 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
204 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
205 $ work( * ), x( * ), xact( * )
212 parameter( one = 1.0e+0, zero = 0.0e+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 REAL AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, DUMMY,
228 $ rcond, rcondc, rcondi, rcondo
231 CHARACTER TRANSS( ntran )
232 INTEGER ISEED( 4 ), ISEEDY( 4 )
233 REAL RESULT( ntests )
237 EXTERNAL clange, sget06
246 INTRINSIC cmplx, 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 ) =
'Complex precision'
271 iseed( i ) = iseedy( i )
278 $ CALL
cerrge( 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
clatb4( path, imat, m, n,
TYPE, KL, KU, ANORM, MODE,
317 CALL
clatms( m, n, dist, iseed,
TYPE, RWORK, MODE,
318 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
324 CALL
alaerh( path,
'CLATMS', 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
claset(
'Full', m, n-izero+1, cmplx( zero ),
347 $ cmplx( zero ), a( ioff+1 ), lda )
367 CALL
clacpy(
'Full', m, n, a, lda, afac, lda )
369 CALL
cgetrf( m, n, afac, lda, iwork, info )
374 $ CALL
alaerh( path,
'CGETRF', info, izero,
' ', m,
375 $ n, -1, -1, nb, imat, nfail, nerrs,
382 CALL
clacpy(
'Full', m, n, afac, lda, ainv, lda )
383 CALL
cget01( m, n, a, lda, ainv, lda, iwork, rwork,
391 IF( m.EQ.n .AND. info.EQ.0 )
THEN
392 CALL
clacpy(
'Full', n, n, afac, lda, ainv, lda )
395 lwork = nmax*max( 3, nrhs )
396 CALL
cgetri( n, ainv, lda, iwork, work, lwork,
402 $ CALL
alaerh( path,
'CGETRI', info, 0,
' ', n, n,
403 $ -1, -1, nb, imat, nfail, nerrs,
410 CALL
cget03( n, a, lda, ainv, lda, work, lda,
411 $ rwork, rcondo, result( 2 ) )
412 anormo = clange(
'O', m, n, a, lda, rwork )
416 anormi = clange(
'I', m, n, a, lda, rwork )
417 ainvnm = clange(
'I', n, n, ainv, lda, rwork )
418 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN
421 rcondi = ( one / anormi ) / ainvnm
429 anormo = clange(
'O', m, n, a, lda, rwork )
430 anormi = clange(
'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
clarhs( path, xtype,
' ', trans, n, n, kl,
475 $ ku, nrhs, a, lda, xact, lda, b,
479 CALL
clacpy(
'Full', n, nrhs, b, lda, x, lda )
481 CALL
cgetrs( trans, n, nrhs, afac, lda, iwork,
487 $ CALL
alaerh( path,
'CGETRS', info, 0, trans,
488 $ n, n, -1, -1, nrhs, imat, nfail,
491 CALL
clacpy(
'Full', n, nrhs, b, lda, work,
493 CALL
cget02( trans, n, n, nrhs, a, lda, x, lda,
494 $ work, lda, rwork, result( 3 ) )
499 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
507 CALL
cgerfs( 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,
'CGERFS', info, 0, trans,
516 $ n, n, -1, -1, nrhs, imat, nfail,
519 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
521 CALL
cget07( 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
cgecon( norm, n, afac, lda, anorm, rcond,
557 $ work, rwork, info )
562 $ CALL
alaerh( path,
'CGECON', info, 0, norm, n,
563 $ n, -1, -1, -1, imat, nfail, nerrs,
570 result( 8 ) = sget06( 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 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 clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine cgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGETRS
subroutine cget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
CGET01
subroutine cerrge(PATH, NUNIT)
CERRGE
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine cgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
CGETRI
subroutine cget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
CGET07
subroutine cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine cgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGERFS
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CGECON
subroutine cchkge(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CCHKGE
subroutine cget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CGET02
subroutine cget03(N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CGET03
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04