183 SUBROUTINE zchkge( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
184 $ NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
185 $ X, XACT, WORK, RWORK, IWORK, NOUT )
193 INTEGER NM, NMAX, NN, NNB, NNS, NOUT
194 DOUBLE PRECISION THRESH
198 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
200 DOUBLE PRECISION RWORK( * )
201 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
202 $ work( * ), x( * ), xact( * )
208 DOUBLE PRECISION ONE, ZERO
209 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
211 parameter( ntypes = 11 )
213 parameter( ntests = 8 )
215 parameter( ntran = 3 )
218 LOGICAL TRFCON, ZEROT
219 CHARACTER DIST, NORM, TRANS,
TYPE, XTYPE
221 INTEGER I, IM, IMAT, IN, INB, INFO, IOFF, IRHS, ITRAN,
222 $ izero, k, kl, ku, lda, lwork, m, mode, n, nb,
223 $ nerrs, nfail, nimat, nrhs, nrun, nt
224 DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, DUMMY,
225 $ RCOND, RCONDC, RCONDI, RCONDO
228 CHARACTER TRANSS( NTRAN )
229 INTEGER ISEED( 4 ), ISEEDY( 4 )
230 DOUBLE PRECISION RESULT( NTESTS )
233 DOUBLE PRECISION DGET06, ZLANGE
234 EXTERNAL DGET06, ZLANGE
243 INTRINSIC dcmplx, max, min
251 COMMON / infoc / infot, nunit, ok, lerr
252 COMMON / srnamc / srnamt
255 DATA iseedy / 1988, 1989, 1990, 1991 / ,
256 $ transs /
'N',
'T',
'C' /
262 path( 1: 1 ) =
'Zomplex precision'
268 iseed( i ) = iseedy( i )
275 $
CALL zerrge( path, nout )
291 IF( m.LE.0 .OR. n.LE.0 )
294 DO 100 imat = 1, nimat
298 IF( .NOT.dotype( imat ) )
303 zerot = imat.GE.5 .AND. imat.LE.7
304 IF( zerot .AND. n.LT.imat-4 )
310 CALL zlatb4( path, imat, m, n,
TYPE, kl, ku, anorm, mode,
314 CALL zlatms( m, n, dist, iseed,
TYPE, rwork, mode,
315 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
321 CALL alaerh( path,
'ZLATMS', info, 0,
' ', m, n, -1,
322 $ -1, -1, imat, nfail, nerrs, nout )
332 ELSE IF( imat.EQ.6 )
THEN
335 izero = min( m, n ) / 2 + 1
337 ioff = ( izero-1 )*lda
343 CALL zlaset(
'Full', m, n-izero+1, dcmplx( zero ),
344 $ dcmplx( zero ), a( ioff+1 ), lda )
364 CALL zlacpy(
'Full', m, n, a, lda, afac, lda )
366 CALL zgetrf( m, n, afac, lda, iwork, info )
371 $
CALL alaerh( path,
'ZGETRF', info, izero,
' ', m,
372 $ n, -1, -1, nb, imat, nfail, nerrs,
379 CALL zlacpy(
'Full', m, n, afac, lda, ainv, lda )
380 CALL zget01( m, n, a, lda, ainv, lda, iwork, rwork,
388 IF( m.EQ.n .AND. info.EQ.0 )
THEN
389 CALL zlacpy(
'Full', n, n, afac, lda, ainv, lda )
392 lwork = nmax*max( 3, nrhs )
393 CALL zgetri( n, ainv, lda, iwork, work, lwork,
399 $
CALL alaerh( path,
'ZGETRI', info, 0,
' ', n, n,
400 $ -1, -1, nb, imat, nfail, nerrs,
407 CALL zget03( n, a, lda, ainv, lda, work, lda,
408 $ rwork, rcondo, result( 2 ) )
409 anormo = zlange(
'O', m, n, a, lda, rwork )
413 anormi = zlange(
'I', m, n, a, lda, rwork )
414 ainvnm = zlange(
'I', n, n, ainv, lda, rwork )
415 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN
418 rcondi = ( one / anormi ) / ainvnm
426 anormo = zlange(
'O', m, n, a, lda, rwork )
427 anormi = zlange(
'I', m, n, a, lda, rwork )
436 IF( result( k ).GE.thresh )
THEN
437 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
438 $
CALL alahd( nout, path )
439 WRITE( nout, fmt = 9999 )m, n, nb, imat, k,
450 IF( inb.GT.1 .OR. m.NE.n )
459 DO 50 itran = 1, ntran
460 trans = transs( itran )
461 IF( itran.EQ.1 )
THEN
471 CALL zlarhs( path, xtype,
' ', trans, n, n, kl,
472 $ ku, nrhs, a, lda, xact, lda, b,
476 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
478 CALL zgetrs( trans, n, nrhs, afac, lda, iwork,
484 $
CALL alaerh( path,
'ZGETRS', info, 0, trans,
485 $ n, n, -1, -1, nrhs, imat, nfail,
488 CALL zlacpy(
'Full', n, nrhs, b, lda, work,
490 CALL zget02( trans, n, n, nrhs, a, lda, x, lda,
491 $ work, lda, rwork, result( 3 ) )
496 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
504 CALL zgerfs( trans, n, nrhs, a, lda, afac, lda,
505 $ iwork, b, lda, x, lda, rwork,
506 $ rwork( nrhs+1 ), work,
507 $ rwork( 2*nrhs+1 ), info )
512 $
CALL alaerh( path,
'ZGERFS', info, 0, trans,
513 $ n, n, -1, -1, nrhs, imat, nfail,
516 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
518 CALL zget07( trans, n, nrhs, a, lda, b, lda, x,
519 $ lda, xact, lda, rwork, .true.,
520 $ rwork( nrhs+1 ), result( 6 ) )
526 IF( result( k ).GE.thresh )
THEN
527 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
528 $
CALL alahd( nout, path )
529 WRITE( nout, fmt = 9998 )trans, n, nrhs,
530 $ imat, k, result( k )
543 IF( itran.EQ.1 )
THEN
553 CALL zgecon( norm, n, afac, lda, anorm, rcond,
554 $ work, rwork, info )
559 $
CALL alaerh( path,
'ZGECON', info, 0, norm, n,
560 $ n, -1, -1, -1, imat, nfail, nerrs,
567 result( 8 ) = dget06( rcond, rcondc )
572 IF( result( 8 ).GE.thresh )
THEN
573 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
574 $
CALL alahd( nout, path )
575 WRITE( nout, fmt = 9997 )norm, n, imat, 8,
589 CALL alasum( path, nout, nfail, nrun, nerrs )
591 9999
FORMAT(
' M = ', i5,
', N =', i5,
', NB =', i4,
', type ', i2,
592 $
', test(', i2,
') =', g12.5 )
593 9998
FORMAT(
' TRANS=''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
594 $ i2,
', test(', i2,
') =', g12.5 )
595 9997
FORMAT(
' NORM =''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
596 $
', test(', i2,
') =', g12.5 )