188      SUBROUTINE cchkgb( 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
 
  203      INTEGER            IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
 
  206      COMPLEX            A( * ), AFAC( * ), B( * ), WORK( * ), X( * ),
 
  214      PARAMETER          ( ONE = 1.0e+0, zero = 0.0e+0 )
 
  215      INTEGER            NTYPES, NTESTS
 
  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, I1, I2, IKL, IKU, IM, IMAT, IN, 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      REAL               AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, RCOND,
 
  229     $                   RCONDC, RCONDI, RCONDO
 
  232      CHARACTER          TRANSS( NTRAN )
 
  233      INTEGER            ISEED( 4 ), ISEEDY( 4 ), KLVAL( NBW ),
 
  235      REAL               RESULT( NTESTS )
 
  238      REAL               CLANGB, CLANGE, SGET06
 
  239      EXTERNAL           CLANGB, CLANGE, SGET06
 
  248      INTRINSIC          cmplx, 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 ) = 
'Complex precision' 
  273         iseed( i ) = iseedy( i )
 
  279     $   
CALL cerrge( 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 clatb4( 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 clatms( m, n, dist, iseed, 
TYPE, rwork,
 
  392     $                               mode, cndnum, anorm, kl, ku, 
'Z',
 
  393     $                               a( koff ), lda, work, info )
 
  398                           CALL alaerh( path, 
'CLATMS', info, 0, 
' ', m,
 
  399     $                                  n, kl, ku, -1, imat, nfail,
 
  403                     ELSE IF( izero.GT.0 ) 
THEN 
  408                        CALL ccopy( 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 ccopy( 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 clacpy( 
'Full', kl+ku+1, n, a, lda,
 
  463     $                                  afac( kl+1 ), ldafac )
 
  465                        CALL cgbtrf( m, n, kl, ku, afac, ldafac, iwork,
 
  471     $                     
CALL alaerh( path, 
'CGBTRF', info, izero,
 
  472     $                                  
' ', m, n, kl, ku, nb, imat,
 
  473     $                                  nfail, nerrs, nout )
 
  480                        CALL cgbt01( m, n, kl, ku, a, lda, afac, ldafac,
 
  481     $                               iwork, work, result( 1 ) )
 
  486                        IF( result( 1 ).GE.thresh ) 
THEN 
  487                           IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
 
  488     $                        
CALL alahd( nout, path )
 
  489                           WRITE( nout, fmt = 9997 )m, n, kl, ku, nb,
 
  490     $                        imat, 1, result( 1 )
 
  498                        IF( inb.GT.1 .OR. m.NE.n )
 
  501                        anormo = clangb( 
'O', n, kl, ku, a, lda, rwork )
 
  502                        anormi = clangb( 
'I', n, kl, ku, a, lda, rwork )
 
  510                           CALL claset( 
'Full', n, n, cmplx( zero ),
 
  511     $                                  cmplx( one ), work, ldb )
 
  513                           CALL cgbtrs( 
'No transpose', n, kl, ku, n,
 
  514     $                                  afac, ldafac, iwork, work, ldb,
 
  519                           ainvnm = clange( 
'O', n, n, work, ldb,
 
  521                           IF( anormo.LE.zero .OR. ainvnm.LE.zero ) 
THEN 
  524                              rcondo = ( one / anormo ) / ainvnm
 
  530                           ainvnm = clange( 
'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 clarhs( path, xtype, 
' ', trans, n,
 
  570     $                                     n, kl, ku, nrhs, a, lda,
 
  571     $                                     xact, ldb, b, ldb, iseed,
 
  574                              CALL clacpy( 
'Full', n, nrhs, b, ldb, x,
 
  578                              CALL cgbtrs( trans, n, kl, ku, nrhs, afac,
 
  579     $                                     ldafac, iwork, x, ldb, info )
 
  584     $                           
CALL alaerh( path, 
'CGBTRS', info, 0,
 
  585     $                                        trans, n, n, kl, ku, -1,
 
  586     $                                        imat, nfail, nerrs, nout )
 
  588                              CALL clacpy( 
'Full', n, nrhs, b, ldb,
 
  590                              CALL cgbt02( trans, m, n, kl, ku, nrhs, a,
 
  591     $                                     lda, x, ldb, work, ldb,
 
  592     $                                     rwork, result( 2 ) )
 
  598                              CALL cget04( n, nrhs, x, ldb, xact, ldb,
 
  599     $                                     rcondc, result( 3 ) )
 
  606                              CALL cgbrfs( 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, 
'CGBRFS', info, 0,
 
  616     $                                        trans, n, n, kl, ku, nrhs,
 
  617     $                                        imat, nfail, nerrs, nout )
 
  619                              CALL cget04( n, nrhs, x, ldb, xact, ldb,
 
  620     $                                     rcondc, result( 4 ) )
 
  621                              CALL cgbt05( trans, n, kl, ku, nrhs, a,
 
  622     $                                     lda, b, ldb, x, ldb, xact,
 
  623     $                                     ldb, rwork, rwork( nrhs+1 ),
 
  630                                 IF( result( k ).GE.thresh ) 
THEN 
  631                                    IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
 
  632     $                                 
CALL alahd( nout, path )
 
  633                                    WRITE( nout, fmt = 9996 )trans, n,
 
  634     $                                 kl, ku, nrhs, imat, k,
 
  648                           IF( itran.EQ.1 ) 
THEN 
  658                           CALL cgbcon( norm, n, kl, ku, afac, ldafac,
 
  659     $                                  iwork, anorm, rcond, work,
 
  665     $                        
CALL alaerh( path, 
'CGBCON', info, 0,
 
  666     $                                     norm, n, n, kl, ku, -1, imat,
 
  667     $                                     nfail, nerrs, nout )
 
  669                           result( 7 ) = sget06( rcond, rcondc )
 
  674                           IF( result( 7 ).GE.thresh ) 
THEN 
  675                              IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
 
  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 CCHKGB, 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 CCHKGB, 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 )