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 )
236 DOUBLE PRECISION DGET06, ZLANGE
237 EXTERNAL DGET06, ZLANGE
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 )