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 )