188 SUBROUTINE zchkgb( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
189 $ NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B,
190 $ X, XACT, WORK, RWORK, IWORK, NOUT )
198 INTEGER LA, LAFAC, NM, NN, NNB, NNS, NOUT
199 DOUBLE PRECISION THRESH
203 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
205 DOUBLE PRECISION RWORK( * )
206 COMPLEX*16 A( * ), AFAC( * ), B( * ), WORK( * ), X( * ),
213 DOUBLE PRECISION ONE, ZERO
214 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
216 parameter( ntypes = 8, ntests = 7 )
218 parameter( nbw = 4, ntran = 3 )
221 LOGICAL TRFCON, ZEROT
222 CHARACTER DIST, NORM, TRANS,
TYPE, XTYPE
224 INTEGER I,, INB, INFO,
225 $ ioff, irhs, itran, izero, j, k, kl, koff, ku,
226 $ lda, ldafac, ldb, m, mode, n, nb, nerrs, nfail,
227 $ nimat, nkl, nku, nrhs, nrun
228 DOUBLE PRECISION AINVNM, , ANORMI, ANORMO, CNDNUM, RCOND,
229 $ RCONDC, RCONDI, RCONDO
232 CHARACTER TRANSS( NTRAN )
233 INTEGER ISEED( 4 ), ISEEDY( 4 ), KLVAL( NBW ),
235 DOUBLE PRECISION RESULT( NTESTS )
238 DOUBLE PRECISION DGET06, ZLANGB, ZLANGE
239 EXTERNAL DGET06, ZLANGB, ZLANGE
248 INTRINSIC dcmplx,
max,
min
256 COMMON / infoc / infot, nunit, ok, lerr
257 COMMON / srnamc / srnamt
260 DATA iseedy / 1988, 1989, 1990, 1991 / ,
261 $ transs /
'N',
'T',
'C' /
267 path( 1: 1 ) =
'Zomplex precision'
273 iseed( i ) = iseedy( i )
279 $
CALL zerrge( path, nout )
294 klval( 2 ) = m + ( m+1 ) / 4
298 klval( 3 ) = ( 3*m-1 ) / 4
299 klval( 4 ) = ( m+1 ) / 4
309 kuval( 2 ) = n + ( n+1 ) / 4
313 kuval( 3 ) = ( 3*n-1 ) / 4
314 kuval( 4 ) = ( n+1 ) / 4
325 IF( m.LE.0 .OR. n.LE.0 )
347 ldafac = 2*kl + ku + 1
348 IF( ( lda*n ).GT.la .OR. ( ldafac*n ).GT.lafac )
THEN
349 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
350 $
CALL alahd( nout, path )
351 IF( n*( kl+ku+1 ).GT.la )
THEN
352 WRITE( nout, fmt = 9999 )la, m, n, kl, ku,
356 IF( n*( 2*kl+ku+1 ).GT.lafac )
THEN
357 WRITE( nout, fmt = 9998 )lafac, m, n, kl, ku,
364 DO 120 imat = 1, nimat
368 IF( .NOT.dotype( imat ) )
374 zerot = imat.GE.2 .AND. imat.LE.4
375 IF( zerot .AND. n.LT.imat-1 )
378 IF( .NOT.zerot .OR. .NOT.dotype( 1 ) )
THEN
383 CALL zlatb4( path, imat, m, n,
TYPE, kl, ku,
384 $ anorm, mode, cndnum, dist )
386 koff =
max( 1, ku+2-n )
387 DO 20 i = 1, koff - 1
391 CALL zlatms( m, n, dist, iseed,
TYPE, rwork,
392 $ mode, cndnum, anorm, kl, ku,
'Z',
393 $ a( koff ), lda, work, info )
398 CALL alaerh( path,
'ZLATMS', info, 0,
' ', m,
399 $ n, kl, ku, -1, imat, nfail,
403 ELSE IF( izero.GT.0 )
THEN
408 CALL zcopy( i2-i1+1, b, 1, a( ioff+i1 ), 1 )
418 ELSE IF( imat.EQ.3 )
THEN
421 izero =
min( m, n ) / 2 + 1
423 ioff = ( izero-1 )*lda
428 i1 =
max( 1, ku+2-izero )
429 i2 =
min( kl+ku+1, ku+1+( m-izero ) )
430 CALL zcopy( i2-i1+1, a( ioff+i1 ), 1, b, 1 )
437 DO 40 i =
max( 1, ku+2-j ),
438 $
min( kl+ku+1, ku+1+( m-j ) )
461 IF( m.GT.0 .AND. n.GT.0 )
462 $
CALL zlacpy(
'Full', kl+ku+1, n, a, lda,
463 $ afac( kl+1 ), ldafac )
465 CALL zgbtrf( m, n, kl, ku, afac, ldafac, iwork,
472 $ ' ', M, N, KL, KU, NB, IMAT,
473 $ NFAIL, NERRS, NOUT )
480 CALL ZGBT01( M, N, KL, KU, A, LDA, AFAC, LDAFAC,
481 $ IWORK, WORK, RESULT( 1 ) )
486.GE.
IF( RESULT( 1 )THRESH ) THEN
487.EQ..AND..EQ.
IF( NFAIL0 NERRS0 )
488 $ CALL ALAHD( NOUT, PATH )
489 WRITE( NOUT, FMT = 9997 )M, N, KL, KU, NB,
490 $ IMAT, 1, RESULT( 1 )
498.GT..OR..NE.
IF( INB1 MN )
501 ANORMO = ZLANGB( 'o', n, kl, ku, a, lda, rwork )
502 anormi = zlangb(
'I', n, kl, ku, a, lda, rwork )
510 CALL zlaset(
'Full', n, n, dcmplx( zero ),
511 $ dcmplx( one ), work, ldb )
513 CALL zgbtrs(
'No transpose', n, kl, ku, n,
514 $ afac, ldafac, iwork, work, ldb,
519 ainvnm = zlange(
'O', n, n, work, ldb,
521 IF( anormo.LE.zero .OR. ainvnm.LE.zero )
THEN
524 rcondo = ( one / anormo ) / ainvnm
530 ainvnm = zlange(
'I', n, n, work, ldb,
532 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN
535 rcondi = ( one / anormi ) / ainvnm
555 DO 70 itran = 1, ntran
556 trans = transs( itran )
557 IF( itran.EQ.1 )
THEN
569 CALL ZLARHS( PATH, XTYPE, ' ', TRANS, N,
570 $ N, KL, KU, NRHS, A, LDA,
571 $ XACT, LDB, B, LDB, ISEED,
574 CALL ZLACPY( 'full
', N, NRHS, B, LDB, X,
578 CALL ZGBTRS( TRANS, N, KL, KU, NRHS, AFAC,
579 $ LDAFAC, IWORK, X, LDB, INFO )
584 $ CALL ALAERH( PATH, 'zgbtrs', INFO, 0,
585 $ TRANS, N, N, KL, KU, -1,
586 $ IMAT, NFAIL, NERRS, NOUT )
588 CALL ZLACPY( 'full
', N, NRHS, B, LDB,
590 CALL ZGBT02( TRANS, M, N, KL, KU, NRHS, A,
591 $ LDA, X, LDB, WORK, LDB,
592 $ RWORK, RESULT( 2 ) )
598 CALL ZGET04( N, NRHS, X, LDB, XACT, LDB,
599 $ RCONDC, RESULT( 3 ) )
606 CALL ZGBRFS( TRANS, N, KL, KU, NRHS, A,
607 $ LDA, AFAC, LDAFAC, IWORK, B,
608 $ LDB, X, LDB, RWORK,
609 $ RWORK( NRHS+1 ), WORK,
610 $ RWORK( 2*NRHS+1 ), INFO )
615 $ CALL ALAERH( PATH, 'zgbrfs', INFO, 0,
616 $ TRANS, N, N, KL, KU, NRHS,
617 $ IMAT, NFAIL, NERRS, NOUT )
619 CALL ZGET04( N, NRHS, X, LDB, XACT, LDB,
620 $ RCONDC, RESULT( 4 ) )
621 CALL ZGBT05( TRANS, N, KL, KU, NRHS, A,
622 $ LDA, B, LDB, X, LDB, XACT,
623 $ LDB, RWORK, RWORK( NRHS+1 ),
630.GE.
IF( RESULT( K )THRESH ) THEN
631.EQ..AND..EQ.
IF( NFAIL0 NERRS0 )
632 $ CALL ALAHD( NOUT, PATH )
633 WRITE( NOUT, FMT = 9996 )TRANS, N,
634 $ KL, KU, NRHS, IMAT, K,
648.EQ.
IF( ITRAN1 ) THEN
658 CALL ZGBCON( NORM, N, KL, KU, AFAC, LDAFAC,
659 $ IWORK, ANORM, RCOND, WORK,
665 $ CALL ALAERH( PATH, 'zgbcon', INFO, 0,
666 $ NORM, N, N, KL, KU, -1, IMAT,
667 $ NFAIL, NERRS, NOUT )
669 RESULT( 7 ) = DGET06( RCOND, RCONDC )
674.GE.
IF( RESULT( 7 )THRESH ) THEN
675.EQ..AND..EQ.
IF( NFAIL0 NERRS0 )
676 $ CALL ALAHD( NOUT, PATH )
677 WRITE( NOUT, FMT = 9995 )NORM, N, KL, KU,
678 $ IMAT, 7, RESULT( 7 )
692 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
694 9999 FORMAT( ' *** in
zchkgb, la=
', I5, ' is too small
for m=
', I5,
695 $ ', n=
', I5, ', kl=
', I4, ', ku=
', I4,
696 $ / ' ==> increase la to at least
', I5 )
697 9998 FORMAT( ' *** in
zchkgb, lafac=', i5,
' is too small for M=', i5,
698 $
', N=', i5,
', KL=', i4,
', KU=', i4,
699 $ /
' ==> Increase LAFAC to at least ', i5 )
700 9997
FORMAT(
' M =', i5,
', N =', i5,
', KL=', i5,
', KU=', i5,
701 $
', NB =', i4,
', type ', i1,
', test(', i1,
')=', g12.5 )
702 9996
FORMAT(
' TRANS=''', a1,
''', N=', i5,
', KL=', i5,
', KU=', i5,
703 $
', NRHS=', i3,
', type ', i1,
', test(', i1,
')=', g12.5 )
704 9995
FORMAT(
' NORM =''', a1,
''', N=', i5,
', KL=', i5,
', KU=', i5
705 $
',', 10x,
' type ', i1,
', test(', i1,
')=', g12.5 )
subroutine zchkgb(dotype, nm, mval, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, a, la, afac, lafac, b, x, xact, work, rwork, iwork, nout)
ZCHKGB