359 SUBROUTINE zchkbb( NSIZES, MVAL, NVAL, NWDTHS, KK, NTYPES, DOTYPE,
360 $ nrhs, iseed, thresh, nounit, a, lda, ab, ldab,
361 $ bd, be, q, ldq, p, ldp, c, ldc, cc, work,
362 $ lwork, rwork, result, info )
370 INTEGER INFO, LDA, LDAB, LDC, LDP, LDQ, LWORK, NOUNIT,
371 $ nrhs, nsizes, ntypes, nwdths
372 DOUBLE PRECISION THRESH
376 INTEGER ISEED( 4 ), KK( * ), MVAL( * ), NVAL( * )
377 DOUBLE PRECISION BD( * ), BE( * ), RESULT( * ), RWORK( * )
378 COMPLEX*16 A( lda, * ), AB( ldab, * ), C( ldc, * ),
379 $ cc( ldc, * ), p( ldp, * ), q( ldq, * ),
386 COMPLEX*16 CZERO, CONE
387 parameter ( czero = ( 0.0d+0, 0.0d+0 ),
388 $ cone = ( 1.0d+0, 0.0d+0 ) )
389 DOUBLE PRECISION ZERO, ONE
390 parameter ( zero = 0.0d+0, one = 1.0d+0 )
392 parameter ( maxtyp = 15 )
395 LOGICAL BADMM, BADNN, BADNNB
396 INTEGER I, IINFO, IMODE, ITYPE, J, JCOL, JR, JSIZE,
397 $ jtype, jwidth, k, kl, kmax, ku, m, mmax, mnmax,
398 $ mnmin, mtypes, n, nerrs, nmats, nmax, ntest,
400 DOUBLE PRECISION AMNINV, ANORM, COND, OVFL, RTOVFL, RTUNFL, ULP,
404 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KMAGN( maxtyp ),
405 $ kmode( maxtyp ), ktype( maxtyp )
408 DOUBLE PRECISION DLAMCH
416 INTRINSIC abs, dble, max, min, sqrt
419 DATA ktype / 1, 2, 5*4, 5*6, 3*9 /
420 DATA kmagn / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3 /
421 DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
439 mmax = max( mmax, mval( j ) )
442 nmax = max( nmax, nval( j ) )
445 mnmax = max( mnmax, min( mval( j ), nval( j ) ) )
451 kmax = max( kmax, kk( j ) )
458 IF( nsizes.LT.0 )
THEN
460 ELSE IF( badmm )
THEN
462 ELSE IF( badnn )
THEN
464 ELSE IF( nwdths.LT.0 )
THEN
466 ELSE IF( badnnb )
THEN
468 ELSE IF( ntypes.LT.0 )
THEN
470 ELSE IF( nrhs.LT.0 )
THEN
472 ELSE IF( lda.LT.nmax )
THEN
474 ELSE IF( ldab.LT.2*kmax+1 )
THEN
476 ELSE IF( ldq.LT.nmax )
THEN
478 ELSE IF( ldp.LT.nmax )
THEN
480 ELSE IF( ldc.LT.nmax )
THEN
482 ELSE IF( ( max( lda, nmax )+1 )*nmax.GT.lwork )
THEN
487 CALL xerbla(
'ZCHKBB', -info )
493 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 .OR. nwdths.EQ.0 )
498 unfl = dlamch(
'Safe minimum' )
500 ulp = dlamch(
'Epsilon' )*dlamch(
'Base' )
502 rtunfl = sqrt( unfl )
503 rtovfl = sqrt( ovfl )
510 DO 160 jsize = 1, nsizes
514 amninv = one / dble( max( 1, m, n ) )
516 DO 150 jwidth = 1, nwdths
518 IF( k.GE.m .AND. k.GE.n )
520 kl = max( 0, min( m-1, k ) )
521 ku = max( 0, min( n-1, k ) )
523 IF( nsizes.NE.1 )
THEN
524 mtypes = min( maxtyp, ntypes )
526 mtypes = min( maxtyp+1, ntypes )
529 DO 140 jtype = 1, mtypes
530 IF( .NOT.dotype( jtype ) )
536 ioldsd( j ) = iseed( j )
554 IF( mtypes.GT.maxtyp )
557 itype = ktype( jtype )
558 imode = kmode( jtype )
562 GO TO ( 40, 50, 60 )kmagn( jtype )
569 anorm = ( rtovfl*ulp )*amninv
573 anorm = rtunfl*max( m, n )*ulpinv
578 CALL zlaset(
'Full', lda, n, czero, czero, a, lda )
579 CALL zlaset(
'Full', ldab, n, czero, czero, ab, ldab )
587 IF( itype.EQ.1 )
THEN
590 ELSE IF( itype.EQ.2 )
THEN
595 a( jcol, jcol ) = anorm
598 ELSE IF( itype.EQ.4 )
THEN
602 CALL zlatms( m, n,
'S', iseed,
'N', rwork, imode,
603 $ cond, anorm, 0, 0,
'N', a, lda, work,
606 ELSE IF( itype.EQ.6 )
THEN
610 CALL zlatms( m, n,
'S', iseed,
'N', rwork, imode,
611 $ cond, anorm, kl, ku,
'N', a, lda, work,
614 ELSE IF( itype.EQ.9 )
THEN
618 CALL zlatmr( m, n,
'S', iseed,
'N', work, 6, one,
619 $ cone,
'T',
'N', work( n+1 ), 1, one,
620 $ work( 2*n+1 ), 1, one,
'N', idumma, kl,
621 $ ku, zero, anorm,
'N', a, lda, idumma,
631 CALL zlatmr( m, nrhs,
'S', iseed,
'N', work, 6, one,
632 $ cone,
'T',
'N', work( m+1 ), 1, one,
633 $ work( 2*m+1 ), 1, one,
'N', idumma, m, nrhs,
634 $ zero, one,
'NO', c, ldc, idumma, iinfo )
636 IF( iinfo.NE.0 )
THEN
637 WRITE( nounit, fmt = 9999 )
'Generator', iinfo, n,
648 DO 100 i = max( 1, j-ku ), min( m, j+kl )
649 ab( ku+1+i-j, j ) = a( i, j )
655 CALL zlacpy(
'Full', m, nrhs, c, ldc, cc, ldc )
659 CALL zgbbrd(
'B', m, n, nrhs, kl, ku, ab, ldab, bd, be,
660 $ q, ldq, p, ldp, cc, ldc, work, rwork,
663 IF( iinfo.NE.0 )
THEN
664 WRITE( nounit, fmt = 9999 )
'ZGBBRD', iinfo, n, jtype,
667 IF( iinfo.LT.0 )
THEN
680 CALL zbdt01( m, n, -1, a, lda, q, ldq, bd, be, p, ldp,
681 $ work, rwork, result( 1 ) )
682 CALL zunt01(
'Columns', m, m, q, ldq, work, lwork, rwork,
684 CALL zunt01(
'Rows', n, n, p, ldp, work, lwork, rwork,
686 CALL zbdt02( m, nrhs, c, ldc, cc, ldc, q, ldq, work,
687 $ rwork, result( 4 ) )
693 ntestt = ntestt + ntest
698 IF( result( jr ).GE.thresh )
THEN
700 $
CALL dlahd2( nounit,
'ZBB' )
702 WRITE( nounit, fmt = 9998 )m, n, k, ioldsd, jtype,
713 CALL dlasum(
'ZBB', nounit, nerrs, ntestt )
716 9999
FORMAT(
' ZCHKBB: ', a,
' returned INFO=', i5,
'.', / 9x,
'M=',
717 $ i5,
' N=', i5,
' K=', i5,
', JTYPE=', i5,
', ISEED=(',
718 $ 3( i5,
',' ), i5,
')' )
719 9998
FORMAT(
' M =', i4,
' N=', i4,
', K=', i3,
', seed=',
720 $ 4( i4,
',' ),
' type ', i2,
', test(', i2,
')=', g10.3 )
subroutine zlatmr(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER, CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM, PACK, A, LDA, IWORK, INFO)
ZLATMR
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
ZUNT01
subroutine zbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RWORK, RESID)
ZBDT01
subroutine zbdt02(M, N, B, LDB, C, LDC, U, LDU, WORK, RWORK, RESID)
ZBDT02
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine dlasum(TYPE, IOUNIT, IE, NRUN)
DLASUM
subroutine dlahd2(IOUNIT, PATH)
DLAHD2
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zchkbb(NSIZES, MVAL, NVAL, NWDTHS, KK, NTYPES, DOTYPE, NRHS, ISEED, THRESH, NOUNIT, A, LDA, AB, LDAB, BD, BE, Q, LDQ, P, LDP, C, LDC, CC, WORK, LWORK, RWORK, RESULT, INFO)
ZCHKBB
subroutine zgbbrd(VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, LDQ, PT, LDPT, C, LDC, WORK, RWORK, INFO)
ZGBBRD