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 )