171 SUBROUTINE cdrvgb( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA,
172 $ afb, lafb, asav, b, bsav, x, xact, s, work,
173 $ rwork, iwork, nout )
182 INTEGER LA, LAFB, NN, NOUT, NRHS
187 INTEGER IWORK( * ), NVAL( * )
188 REAL RWORK( * ), S( * )
189 COMPLEX A( * ), AFB( * ), ASAV( * ), B( * ), BSAV( * ),
190 $ work( * ), x( * ), xact( * )
197 parameter( one = 1.0e+0, zero = 0.0e+0 )
199 parameter( ntypes = 8 )
201 parameter( ntests = 7 )
203 parameter( ntran = 3 )
206 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
207 CHARACTER DIST, EQUED, FACT, TRANS,
TYPE, XTYPE
209 INTEGER I, I1, I2, IEQUED, IFACT, IKL, IKU, IMAT, IN,
210 $ info, ioff, itran, izero, j, k, k1, kl, ku,
211 $ lda, ldafb, ldb, mode, n, nb, nbmin, nerrs,
212 $ nfact, nfail, nimat, nkl, nku, nrun, nt
213 REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, ANRMPV,
214 $ cndnum, colcnd, rcond, rcondc, rcondi, rcondo,
215 $ roldc, roldi, roldo, rowcnd, rpvgrw
218 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( ntran )
219 INTEGER ISEED( 4 ), ISEEDY( 4 )
220 REAL RDUM( 1 ), RESULT( ntests )
224 REAL CLANGB, CLANGE, CLANTB, SGET06, SLAMCH
225 EXTERNAL lsame, clangb, clange, clantb, sget06, slamch
234 INTRINSIC abs, cmplx, max, min
242 COMMON / infoc / infot, nunit, ok, lerr
243 COMMON / srnamc / srnamt
246 DATA iseedy / 1988, 1989, 1990, 1991 /
247 DATA transs /
'N',
'T',
'C' /
248 DATA facts /
'F',
'N',
'E' /
249 DATA equeds /
'N',
'R',
'C',
'B' /
255 path( 1: 1 ) =
'Complex precision'
261 iseed( i ) = iseedy( i )
267 $ CALL
cerrvx( path, nout )
286 nkl = max( 1, min( n, 4 ) )
301 ELSE IF( ikl.EQ.2 )
THEN
303 ELSE IF( ikl.EQ.3 )
THEN
305 ELSE IF( ikl.EQ.4 )
THEN
316 ELSE IF( iku.EQ.2 )
THEN
318 ELSE IF( iku.EQ.3 )
THEN
320 ELSE IF( iku.EQ.4 )
THEN
328 ldafb = 2*kl + ku + 1
329 IF( lda*n.GT.la .OR. ldafb*n.GT.lafb )
THEN
330 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
331 $ CALL
aladhd( nout, path )
332 IF( lda*n.GT.la )
THEN
333 WRITE( nout, fmt = 9999 )la, n, kl, ku,
337 IF( ldafb*n.GT.lafb )
THEN
338 WRITE( nout, fmt = 9998 )lafb, n, kl, ku,
345 DO 120 imat = 1, nimat
349 IF( .NOT.dotype( imat ) )
354 zerot = imat.GE.2 .AND. imat.LE.4
355 IF( zerot .AND. n.LT.imat-1 )
361 CALL
clatb4( path, imat, n, n,
TYPE, KL, KU, ANORM,
362 $ mode, cndnum, dist )
363 rcondc = one / cndnum
366 CALL
clatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
367 $ cndnum, anorm, kl, ku,
'Z', a, lda, work,
373 CALL
alaerh( path,
'CLATMS', info, 0,
' ', n, n,
374 $ kl, ku, -1, imat, nfail, nerrs, nout )
385 ELSE IF( imat.EQ.3 )
THEN
390 ioff = ( izero-1 )*lda
392 i1 = max( 1, ku+2-izero )
393 i2 = min( kl+ku+1, ku+1+( n-izero ) )
399 DO 30 i = max( 1, ku+2-j ),
400 $ min( kl+ku+1, ku+1+( n-j ) )
410 CALL
clacpy(
'Full', kl+ku+1, n, a, lda, asav, lda )
413 equed = equeds( iequed )
414 IF( iequed.EQ.1 )
THEN
420 DO 100 ifact = 1, nfact
421 fact = facts( ifact )
422 prefac = lsame( fact,
'F' )
423 nofact = lsame( fact,
'N' )
424 equil = lsame( fact,
'E' )
432 ELSE IF( .NOT.nofact )
THEN
439 CALL
clacpy(
'Full', kl+ku+1, n, asav, lda,
440 $ afb( kl+1 ), ldafb )
441 IF( equil .OR. iequed.GT.1 )
THEN
446 CALL
cgbequ( n, n, kl, ku, afb( kl+1 ),
447 $ ldafb, s, s( n+1 ), rowcnd,
448 $ colcnd, amax, info )
449 IF( info.EQ.0 .AND. n.GT.0 )
THEN
450 IF( lsame( equed,
'R' ) )
THEN
453 ELSE IF( lsame( equed,
'C' ) )
THEN
456 ELSE IF( lsame( equed,
'B' ) )
THEN
463 CALL
claqgb( n, n, kl, ku, afb( kl+1 ),
464 $ ldafb, s, s( n+1 ),
465 $ rowcnd, colcnd, amax,
480 anormo = clangb(
'1', n, kl, ku, afb( kl+1 ),
482 anormi = clangb(
'I', n, kl, ku, afb( kl+1 ),
487 CALL
cgbtrf( n, n, kl, ku, afb, ldafb, iwork,
492 CALL
claset(
'Full', n, n, cmplx( zero ),
493 $ cmplx( one ), work, ldb )
495 CALL
cgbtrs(
'No transpose', n, kl, ku, n,
496 $ afb, ldafb, iwork, work, ldb,
501 ainvnm = clange(
'1', n, n, work, ldb,
503 IF( anormo.LE.zero .OR. ainvnm.LE.zero )
THEN
506 rcondo = ( one / anormo ) / ainvnm
512 ainvnm = clange(
'I', n, n, work, ldb,
514 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN
517 rcondi = ( one / anormi ) / ainvnm
521 DO 90 itran = 1, ntran
525 trans = transs( itran )
526 IF( itran.EQ.1 )
THEN
534 CALL
clacpy(
'Full', kl+ku+1, n, asav, lda,
541 CALL
clarhs( path, xtype,
'Full', trans, n,
542 $ n, kl, ku, nrhs, a, lda, xact,
543 $ ldb, b, ldb, iseed, info )
545 CALL
clacpy(
'Full', n, nrhs, b, ldb, bsav,
548 IF( nofact .AND. itran.EQ.1 )
THEN
555 CALL
clacpy(
'Full', kl+ku+1, n, a, lda,
556 $ afb( kl+1 ), ldafb )
557 CALL
clacpy(
'Full', n, nrhs, b, ldb, x,
561 CALL
cgbsv( n, kl, ku, nrhs, afb, ldafb,
562 $ iwork, x, ldb, info )
567 $ CALL
alaerh( path,
'CGBSV ', info,
568 $ izero,
' ', n, n, kl, ku,
569 $ nrhs, imat, nfail, nerrs,
575 CALL
cgbt01( n, n, kl, ku, a, lda, afb,
576 $ ldafb, iwork, work,
579 IF( izero.EQ.0 )
THEN
584 CALL
clacpy(
'Full', n, nrhs, b, ldb,
586 CALL
cgbt02(
'No transpose', n, n, kl,
587 $ ku, nrhs, a, lda, x, ldb,
588 $ work, ldb, result( 2 ) )
593 CALL
cget04( n, nrhs, x, ldb, xact,
594 $ ldb, rcondc, result( 3 ) )
602 IF( result( k ).GE.thresh )
THEN
603 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
604 $ CALL
aladhd( nout, path )
605 WRITE( nout, fmt = 9997 )
'CGBSV ',
606 $ n, kl, ku, imat, k, result( k )
616 $ CALL
claset(
'Full', 2*kl+ku+1, n,
617 $ cmplx( zero ), cmplx( zero ),
619 CALL
claset(
'Full', n, nrhs, cmplx( zero ),
620 $ cmplx( zero ), x, ldb )
621 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
626 CALL
claqgb( n, n, kl, ku, a, lda, s,
627 $ s( n+1 ), rowcnd, colcnd,
635 CALL
cgbsvx( fact, trans, n, kl, ku, nrhs, a,
636 $ lda, afb, ldafb, iwork, equed,
637 $ s, s( ldb+1 ), b, ldb, x, ldb,
638 $ rcond, rwork, rwork( nrhs+1 ),
639 $ work, rwork( 2*nrhs+1 ), info )
644 $ CALL
alaerh( path,
'CGBSVX', info, izero,
645 $ fact // trans, n, n, kl, ku,
646 $ nrhs, imat, nfail, nerrs,
651 IF( info.NE.0 .AND. info.LE.n)
THEN
654 DO 60 i = max( ku+2-j, 1 ),
655 $ min( n+ku+1-j, kl+ku+1 )
656 anrmpv = max( anrmpv,
657 $ abs( a( i+( j-1 )*lda ) ) )
660 rpvgrw = clantb(
'M',
'U',
'N', info,
661 $ min( info-1, kl+ku ),
662 $ afb( max( 1, kl+ku+2-info ) ),
664 IF( rpvgrw.EQ.zero )
THEN
667 rpvgrw = anrmpv / rpvgrw
670 rpvgrw = clantb(
'M',
'U',
'N', n, kl+ku,
672 IF( rpvgrw.EQ.zero )
THEN
675 rpvgrw = clangb(
'M', n, kl, ku, a,
676 $ lda, rdum ) / rpvgrw
679 result( 7 ) = abs( rpvgrw-rwork( 2*nrhs+1 ) )
680 $ / max( rwork( 2*nrhs+1 ),
681 $ rpvgrw ) / slamch(
'E' )
683 IF( .NOT.prefac )
THEN
688 CALL
cgbt01( n, n, kl, ku, a, lda, afb,
689 $ ldafb, iwork, work,
701 CALL
clacpy(
'Full', n, nrhs, bsav, ldb,
703 CALL
cgbt02( trans, n, n, kl, ku, nrhs,
704 $ asav, lda, x, ldb, work, ldb,
710 IF( nofact .OR. ( prefac .AND.
711 $ lsame( equed,
'N' ) ) )
THEN
712 CALL
cget04( n, nrhs, x, ldb, xact,
713 $ ldb, rcondc, result( 3 ) )
715 IF( itran.EQ.1 )
THEN
720 CALL
cget04( n, nrhs, x, ldb, xact,
721 $ ldb, roldc, result( 3 ) )
727 CALL
cgbt05( trans, n, kl, ku, nrhs, asav,
728 $ lda, bsav, ldb, x, ldb, xact,
729 $ ldb, rwork, rwork( nrhs+1 ),
738 result( 6 ) = sget06( rcond, rcondc )
743 IF( .NOT.trfcon )
THEN
745 IF( result( k ).GE.thresh )
THEN
746 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
747 $ CALL
aladhd( nout, path )
749 WRITE( nout, fmt = 9995 )
750 $
'CGBSVX', fact, trans, n, kl,
751 $ ku, equed, imat, k,
754 WRITE( nout, fmt = 9996 )
755 $
'CGBSVX', fact, trans, n, kl,
756 $ ku, imat, k, result( k )
763 IF( result( 1 ).GE.thresh .AND. .NOT.
765 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
766 $ CALL
aladhd( nout, path )
768 WRITE( nout, fmt = 9995 )
'CGBSVX',
769 $ fact, trans, n, kl, ku, equed,
770 $ imat, 1, result( 1 )
772 WRITE( nout, fmt = 9996 )
'CGBSVX',
773 $ fact, trans, n, kl, ku, imat, 1,
779 IF( result( 6 ).GE.thresh )
THEN
780 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
781 $ CALL
aladhd( nout, path )
783 WRITE( nout, fmt = 9995 )
'CGBSVX',
784 $ fact, trans, n, kl, ku, equed,
785 $ imat, 6, result( 6 )
787 WRITE( nout, fmt = 9996 )
'CGBSVX',
788 $ fact, trans, n, kl, ku, imat, 6,
794 IF( result( 7 ).GE.thresh )
THEN
795 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
796 $ CALL
aladhd( nout, path )
798 WRITE( nout, fmt = 9995 )
'CGBSVX',
799 $ fact, trans, n, kl, ku, equed,
800 $ imat, 7, result( 7 )
802 WRITE( nout, fmt = 9996 )
'CGBSVX',
803 $ fact, trans, n, kl, ku, imat, 7,
820 CALL
alasvm( path, nout, nfail, nrun, nerrs )
822 9999
FORMAT(
' *** In CDRVGB, LA=', i5,
' is too small for N=', i5,
823 $
', KU=', i5,
', KL=', i5, /
' ==> Increase LA to at least ',
825 9998
FORMAT(
' *** In CDRVGB, LAFB=', i5,
' is too small for N=', i5,
826 $
', KU=', i5,
', KL=', i5, /
827 $
' ==> Increase LAFB to at least ', i5 )
828 9997
FORMAT( 1x, a,
', N=', i5,
', KL=', i5,
', KU=', i5,
', type ',
829 $ i1,
', test(', i1,
')=', g12.5 )
830 9996
FORMAT( 1x, a,
'( ''', a1,
''',''', a1,
''',', i5,
',', i5,
',',
831 $ i5,
',...), type ', i1,
', test(', i1,
')=', g12.5 )
832 9995
FORMAT( 1x, a,
'( ''', a1,
''',''', a1,
''',', i5,
',', i5,
',',
833 $ i5,
',...), EQUED=''', a1,
''', type ', i1,
', test(', i1,
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine cgbt05(TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CGBT05
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine cdrvgb(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA, AFB, LAFB, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
CDRVGB
subroutine claqgb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, EQUED)
CLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ...
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine cgbsvx(FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CGBSVX computes the solution to system of linear equations A * X = B for GB matrices ...
subroutine cgbsv(N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver) ...
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cgbt01(M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
CGBT01
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine cerrvx(PATH, NUNIT)
CERRVX
subroutine cgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
CGBEQU
subroutine cgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBTRS
subroutine cgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
CGBTRF
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine cgbt02(TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RESID)
CGBT02