353 SUBROUTINE dchkbb( NSIZES, MVAL, NVAL, NWDTHS, KK, NTYPES, DOTYPE,
354 $ nrhs, iseed, thresh, nounit, a, lda, ab, ldab,
355 $ bd, be, q, ldq, p, ldp, c, ldc, cc, work,
356 $ lwork, result, info )
364 INTEGER INFO, LDA, LDAB, LDC, LDP, LDQ, LWORK, NOUNIT,
365 $ nrhs, nsizes, ntypes, nwdths
366 DOUBLE PRECISION THRESH
370 INTEGER ISEED( 4 ), KK( * ), MVAL( * ), NVAL( * )
371 DOUBLE PRECISION A( lda, * ), AB( ldab, * ), BD( * ), BE( * ),
372 $ c( ldc, * ), cc( ldc, * ), p( ldp, * ),
373 $ q( ldq, * ), result( * ), work( * )
379 DOUBLE PRECISION ZERO, ONE
380 parameter ( zero = 0.0d0, one = 1.0d0 )
382 parameter ( maxtyp = 15 )
385 LOGICAL BADMM, BADNN, BADNNB
386 INTEGER I, IINFO, IMODE, ITYPE, J, JCOL, JR, JSIZE,
387 $ jtype, jwidth, k, kl, kmax, ku, m, mmax, mnmax,
388 $ mnmin, mtypes, n, nerrs, nmats, nmax, ntest,
390 DOUBLE PRECISION AMNINV, ANORM, COND, OVFL, RTOVFL, RTUNFL, ULP,
394 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KMAGN( maxtyp ),
395 $ kmode( maxtyp ), ktype( maxtyp )
398 DOUBLE PRECISION DLAMCH
406 INTRINSIC abs, dble, max, min, sqrt
409 DATA ktype / 1, 2, 5*4, 5*6, 3*9 /
410 DATA kmagn / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3 /
411 DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
429 mmax = max( mmax, mval( j ) )
432 nmax = max( nmax, nval( j ) )
435 mnmax = max( mnmax, min( mval( j ), nval( j ) ) )
441 kmax = max( kmax, kk( j ) )
448 IF( nsizes.LT.0 )
THEN
450 ELSE IF( badmm )
THEN
452 ELSE IF( badnn )
THEN
454 ELSE IF( nwdths.LT.0 )
THEN
456 ELSE IF( badnnb )
THEN
458 ELSE IF( ntypes.LT.0 )
THEN
460 ELSE IF( nrhs.LT.0 )
THEN
462 ELSE IF( lda.LT.nmax )
THEN
464 ELSE IF( ldab.LT.2*kmax+1 )
THEN
466 ELSE IF( ldq.LT.nmax )
THEN
468 ELSE IF( ldp.LT.nmax )
THEN
470 ELSE IF( ldc.LT.nmax )
THEN
472 ELSE IF( ( max( lda, nmax )+1 )*nmax.GT.lwork )
THEN
477 CALL xerbla(
'DCHKBB', -info )
483 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 .OR. nwdths.EQ.0 )
488 unfl = dlamch(
'Safe minimum' )
490 ulp = dlamch(
'Epsilon' )*dlamch(
'Base' )
492 rtunfl = sqrt( unfl )
493 rtovfl = sqrt( ovfl )
500 DO 160 jsize = 1, nsizes
504 amninv = one / dble( max( 1, m, n ) )
506 DO 150 jwidth = 1, nwdths
508 IF( k.GE.m .AND. k.GE.n )
510 kl = max( 0, min( m-1, k ) )
511 ku = max( 0, min( n-1, k ) )
513 IF( nsizes.NE.1 )
THEN
514 mtypes = min( maxtyp, ntypes )
516 mtypes = min( maxtyp+1, ntypes )
519 DO 140 jtype = 1, mtypes
520 IF( .NOT.dotype( jtype ) )
526 ioldsd( j ) = iseed( j )
544 IF( mtypes.GT.maxtyp )
547 itype = ktype( jtype )
548 imode = kmode( jtype )
552 GO TO ( 40, 50, 60 )kmagn( jtype )
559 anorm = ( rtovfl*ulp )*amninv
563 anorm = rtunfl*max( m, n )*ulpinv
568 CALL dlaset(
'Full', lda, n, zero, zero, a, lda )
569 CALL dlaset(
'Full', ldab, n, zero, zero, ab, ldab )
577 IF( itype.EQ.1 )
THEN
580 ELSE IF( itype.EQ.2 )
THEN
585 a( jcol, jcol ) = anorm
588 ELSE IF( itype.EQ.4 )
THEN
592 CALL dlatms( m, n,
'S', iseed,
'N', work, imode, cond,
593 $ anorm, 0, 0,
'N', a, lda, work( m+1 ),
596 ELSE IF( itype.EQ.6 )
THEN
600 CALL dlatms( m, n,
'S', iseed,
'N', work, imode, cond,
601 $ anorm, kl, ku,
'N', a, lda, work( m+1 ),
604 ELSE IF( itype.EQ.9 )
THEN
608 CALL dlatmr( m, n,
'S', iseed,
'N', work, 6, one, one,
609 $
'T',
'N', work( n+1 ), 1, one,
610 $ work( 2*n+1 ), 1, one,
'N', idumma, kl,
611 $ ku, zero, anorm,
'N', a, lda, idumma,
621 CALL dlatmr( m, nrhs,
'S', iseed,
'N', work, 6, one, one,
622 $
'T',
'N', work( m+1 ), 1, one,
623 $ work( 2*m+1 ), 1, one,
'N', idumma, m, nrhs,
624 $ zero, one,
'NO', c, ldc, idumma, iinfo )
626 IF( iinfo.NE.0 )
THEN
627 WRITE( nounit, fmt = 9999 )
'Generator', iinfo, n,
638 DO 100 i = max( 1, j-ku ), min( m, j+kl )
639 ab( ku+1+i-j, j ) = a( i, j )
645 CALL dlacpy(
'Full', m, nrhs, c, ldc, cc, ldc )
649 CALL dgbbrd(
'B', m, n, nrhs, kl, ku, ab, ldab, bd, be,
650 $ q, ldq, p, ldp, cc, ldc, work, iinfo )
652 IF( iinfo.NE.0 )
THEN
653 WRITE( nounit, fmt = 9999 )
'DGBBRD', iinfo, n, jtype,
656 IF( iinfo.LT.0 )
THEN
669 CALL dbdt01( m, n, -1, a, lda, q, ldq, bd, be, p, ldp,
670 $ work, result( 1 ) )
671 CALL dort01(
'Columns', m, m, q, ldq, work, lwork,
673 CALL dort01(
'Rows', n, n, p, ldp, work, lwork,
675 CALL dbdt02( m, nrhs, c, ldc, cc, ldc, q, ldq, work,
682 ntestt = ntestt + ntest
687 IF( result( jr ).GE.thresh )
THEN
689 $
CALL dlahd2( nounit,
'DBB' )
691 WRITE( nounit, fmt = 9998 )m, n, k, ioldsd, jtype,
702 CALL dlasum(
'DBB', nounit, nerrs, ntestt )
705 9999
FORMAT(
' DCHKBB: ', a,
' returned INFO=', i5,
'.', / 9x,
'M=',
706 $ i5,
' N=', i5,
' K=', i5,
', JTYPE=', i5,
', ISEED=(',
707 $ 3( i5,
',' ), i5,
')' )
708 9998
FORMAT(
' M =', i4,
' N=', i4,
', K=', i3,
', seed=',
709 $ 4( i4,
',' ),
' type ', i2,
', test(', i2,
')=', g10.3 )
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dlatmr(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)
DLATMR
subroutine dbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RESID)
DBDT01
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine dgbbrd(VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, LDQ, PT, LDPT, C, LDC, WORK, INFO)
DGBBRD
subroutine dbdt02(M, N, B, LDB, C, LDC, U, LDU, WORK, RESID)
DBDT02
subroutine dchkbb(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, RESULT, INFO)
DCHKBB
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlasum(TYPE, IOUNIT, IE, NRUN)
DLASUM
subroutine dlahd2(IOUNIT, PATH)
DLAHD2
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dort01(ROWCOL, M, N, U, LDU, WORK, LWORK, RESID)
DORT01