190 SUBROUTINE zchkgb( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
191 $ NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B,
192 $ X, XACT, WORK, RWORK, IWORK, NOUT )
201 INTEGER LA, LAFAC, NM, NN, NNB, NNS, NOUT
202 DOUBLE PRECISION THRESH
206 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
208 DOUBLE PRECISION RWORK( * )
209 COMPLEX*16 A( * ), AFAC( * ), B( * ), WORK( * ), X( * ),
216 DOUBLE PRECISION ONE, ZERO
217 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
218 INTEGER NTYPES, NTESTS
219 parameter( ntypes = 8, ntests = 7 )
221 parameter( nbw = 4, ntran = 3 )
224 LOGICAL TRFCON, ZEROT
225 CHARACTER DIST, NORM, TRANS,
TYPE, XTYPE
227 INTEGER I, I1, I2, IKL, IKU, IM, IMAT, IN, INB, INFO,
228 $ ioff, irhs, itran, izero, j, k, kl, koff, ku,
229 $ lda, ldafac, ldb, m, mode, n, nb, nerrs, nfail,
230 $ nimat, nkl, nku, nrhs, nrun
231 DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, RCOND,
232 $ RCONDC, RCONDI, RCONDO
235 CHARACTER TRANSS( NTRAN )
236 INTEGER ISEED( 4 ), ISEEDY( 4 ), KLVAL( NBW ),
238 DOUBLE PRECISION RESULT( NTESTS )
241 DOUBLE PRECISION DGET06, ZLANGB, ZLANGE
242 EXTERNAL DGET06, ZLANGB, ZLANGE
251 INTRINSIC dcmplx, max, min
259 COMMON / infoc / infot, nunit, ok, lerr
260 COMMON / srnamc / srnamt
263 DATA iseedy / 1988, 1989, 1990, 1991 / ,
264 $ transs /
'N',
'T',
'C' /
270 path( 1: 1 ) =
'Zomplex precision'
276 iseed( i ) = iseedy( i )
282 $
CALL zerrge( path, nout )
297 klval( 2 ) = m + ( m+1 ) / 4
301 klval( 3 ) = ( 3*m-1 ) / 4
302 klval( 4 ) = ( m+1 ) / 4
312 kuval( 2 ) = n + ( n+1 ) / 4
316 kuval( 3 ) = ( 3*n-1 ) / 4
317 kuval( 4 ) = ( n+1 ) / 4
328 IF( m.LE.0 .OR. n.LE.0 )
350 ldafac = 2*kl + ku + 1
351 IF( ( lda*n ).GT.la .OR. ( ldafac*n ).GT.lafac )
THEN
352 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
353 $
CALL alahd( nout, path )
354 IF( n*( kl+ku+1 ).GT.la )
THEN
355 WRITE( nout, fmt = 9999 )la, m, n, kl, ku,
359 IF( n*( 2*kl+ku+1 ).GT.lafac )
THEN
360 WRITE( nout, fmt = 9998 )lafac, m, n, kl, ku,
367 DO 120 imat = 1, nimat
371 IF( .NOT.dotype( imat ) )
377 zerot = imat.GE.2 .AND. imat.LE.4
378 IF( zerot .AND. n.LT.imat-1 )
381 IF( .NOT.zerot .OR. .NOT.dotype( 1 ) )
THEN
386 CALL zlatb4( path, imat, m, n,
TYPE, kl, ku,
387 $ anorm, mode, cndnum, dist )
389 koff = max( 1, ku+2-n )
390 DO 20 i = 1, koff - 1
394 CALL zlatms( m, n, dist, iseed,
TYPE, rwork,
395 $ mode, cndnum, anorm, kl, ku,
'Z',
396 $ a( koff ), lda, work, info )
401 CALL alaerh( path,
'ZLATMS', info, 0,
' ', m,
402 $ n, kl, ku, -1, imat, nfail,
406 ELSE IF( izero.GT.0 )
THEN
411 CALL zcopy( i2-i1+1, b, 1, a( ioff+i1 ), 1 )
421 ELSE IF( imat.EQ.3 )
THEN
424 izero = min( m, n ) / 2 + 1
426 ioff = ( izero-1 )*lda
431 i1 = max( 1, ku+2-izero )
432 i2 = min( kl+ku+1, ku+1+( m-izero ) )
433 CALL zcopy( i2-i1+1, a( ioff+i1 ), 1, b, 1 )
440 DO 40 i = max( 1, ku+2-j ),
441 $ min( kl+ku+1, ku+1+( m-j ) )
464 IF( m.GT.0 .AND. n.GT.0 )
465 $
CALL zlacpy(
'Full', kl+ku+1, n, a, lda,
466 $ afac( kl+1 ), ldafac )
468 CALL zgbtrf( m, n, kl, ku, afac, ldafac, iwork,
474 $
CALL alaerh( path,
'ZGBTRF', info, izero,
475 $
' ', m, n, kl, ku, nb, imat,
476 $ nfail, nerrs, nout )
483 CALL zgbt01( m, n, kl, ku, a, lda, afac, ldafac,
484 $ iwork, work, result( 1 ) )
489 IF( result( 1 ).GE.thresh )
THEN
490 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
491 $
CALL alahd( nout, path )
492 WRITE( nout, fmt = 9997 )m, n, kl, ku, nb,
493 $ imat, 1, result( 1 )
501 IF( inb.GT.1 .OR. m.NE.n )
504 anormo = zlangb(
'O', n, kl, ku, a, lda, rwork )
505 anormi = zlangb(
'I', n, kl, ku, a, lda, rwork )
513 CALL zlaset(
'Full', n, n, dcmplx( zero ),
514 $ dcmplx( one ), work, ldb )
516 CALL zgbtrs(
'No transpose', n, kl, ku, n,
517 $ afac, ldafac, iwork, work, ldb,
522 ainvnm = zlange(
'O', n, n, work, ldb,
524 IF( anormo.LE.zero .OR. ainvnm.LE.zero )
THEN
527 rcondo = ( one / anormo ) / ainvnm
533 ainvnm = zlange(
'I', n, n, work, ldb,
535 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN
538 rcondi = ( one / anormi ) / ainvnm
558 DO 70 itran = 1, ntran
559 trans = transs( itran )
560 IF( itran.EQ.1 )
THEN
572 CALL zlarhs( path, xtype,
' ', trans, n,
573 $ n, kl, ku, nrhs, a, lda,
574 $ xact, ldb, b, ldb, iseed,
577 CALL zlacpy(
'Full', n, nrhs, b, ldb, x,
581 CALL zgbtrs( trans, n, kl, ku, nrhs, afac,
582 $ ldafac, iwork, x, ldb, info )
587 $
CALL alaerh( path,
'ZGBTRS', info, 0,
588 $ trans, n, n, kl, ku, -1,
589 $ imat, nfail, nerrs, nout )
591 CALL zlacpy(
'Full', n, nrhs, b, ldb,
593 CALL zgbt02( trans, m, n, kl, ku, nrhs, a,
594 $ lda, x, ldb, work, ldb,
601 CALL zget04( n, nrhs, x, ldb, xact, ldb,
602 $ rcondc, result( 3 ) )
609 CALL zgbrfs( trans, n, kl, ku, nrhs, a,
610 $ lda, afac, ldafac, iwork, b,
611 $ ldb, x, ldb, rwork,
612 $ rwork( nrhs+1 ), work,
613 $ rwork( 2*nrhs+1 ), info )
618 $
CALL alaerh( path,
'ZGBRFS', info, 0,
619 $ trans, n, n, kl, ku, nrhs,
620 $ imat, nfail, nerrs, nout )
622 CALL zget04( n, nrhs, x, ldb, xact, ldb,
623 $ rcondc, result( 4 ) )
624 CALL zgbt05( trans, n, kl, ku, nrhs, a,
625 $ lda, b, ldb, x, ldb, xact,
626 $ ldb, rwork, rwork( nrhs+1 ),
633 IF( result( k ).GE.thresh )
THEN
634 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
635 $
CALL alahd( nout, path )
636 WRITE( nout, fmt = 9996 )trans, n,
637 $ kl, ku, nrhs, imat, k,
651 IF( itran.EQ.1 )
THEN
661 CALL zgbcon( norm, n, kl, ku, afac, ldafac,
662 $ iwork, anorm, rcond, work,
668 $
CALL alaerh( path,
'ZGBCON', info, 0,
669 $ norm, n, n, kl, ku, -1, imat,
670 $ nfail, nerrs, nout )
672 result( 7 ) = dget06( rcond, rcondc )
677 IF( result( 7 ).GE.thresh )
THEN
678 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
679 $
CALL alahd( nout, path )
680 WRITE( nout, fmt = 9995 )norm, n, kl, ku,
681 $ imat, 7, result( 7 )
695 CALL alasum( path, nout, nfail, nrun, nerrs )
697 9999
FORMAT(
' *** In ZCHKGB, LA=', i5,
' is too small for M=', i5,
698 $
', N=', i5,
', KL=', i4,
', KU=', i4,
699 $ /
' ==> Increase LA to at least ', i5 )
700 9998
FORMAT(
' *** In ZCHKGB, LAFAC=', i5,
' is too small for M=', i5,
701 $
', N=', i5,
', KL=', i4,
', KU=', i4,
702 $ /
' ==> Increase LAFAC to at least ', i5 )
703 9997
FORMAT(
' M =', i5,
', N =', i5,
', KL=', i5,
', KU=', i5,
704 $
', NB =', i4,
', type ', i1,
', test(', i1,
')=', g12.5 )
705 9996
FORMAT(
' TRANS=''', a1,
''', N=', i5,
', KL=', i5,
', KU=', i5,
706 $
', NRHS=', i3,
', type ', i1,
', test(', i1,
')=', g12.5 )
707 9995
FORMAT(
' NORM =''', a1,
''', N=', i5,
', KL=', i5,
', KU=', i5,
708 $
',', 10x,
' type ', i1,
', test(', i1,
')=', g12.5 )