353 SUBROUTINE schkbb( 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
370 INTEGER ISEED( 4 ), KK( * ), MVAL( * ), NVAL( * )
371 REAL A( lda, * ), AB( ldab, * ), BD( * ), BE( * ),
372 $ c( ldc, * ), cc( ldc, * ), p( ldp, * ),
373 $ q( ldq, * ), result( * ), work( * )
380 parameter ( zero = 0.0e0, one = 1.0e0 )
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 REAL AMNINV, ANORM, COND, OVFL, RTOVFL, RTUNFL, ULP,
394 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KMAGN( maxtyp ),
395 $ kmode( maxtyp ), ktype( maxtyp )
406 INTRINSIC abs, max, min,
REAL, 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(
'SCHKBB', -info )
483 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 .OR. nwdths.EQ.0 )
488 unfl = slamch(
'Safe minimum' )
490 ulp = slamch(
'Epsilon' )*slamch(
'Base' )
492 rtunfl = sqrt( unfl )
493 rtovfl = sqrt( ovfl )
500 DO 160 jsize = 1, nsizes
504 amninv = one /
REAL( 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 slaset(
'Full', lda, n, zero, zero, a, lda )
569 CALL slaset(
'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 slatms( 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 slatms( 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 slatmr( 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 slatmr( 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 slacpy(
'Full', m, nrhs, c, ldc, cc, ldc )
649 CALL sgbbrd(
'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 )
'SGBBRD', iinfo, n, jtype,
656 IF( iinfo.LT.0 )
THEN
669 CALL sbdt01( m, n, -1, a, lda, q, ldq, bd, be, p, ldp,
670 $ work, result( 1 ) )
671 CALL sort01(
'Columns', m, m, q, ldq, work, lwork,
673 CALL sort01(
'Rows', n, n, p, ldp, work, lwork,
675 CALL sbdt02( m, nrhs, c, ldc, cc, ldc, q, ldq, work,
682 ntestt = ntestt + ntest
687 IF( result( jr ).GE.thresh )
THEN
689 $
CALL slahd2( nounit,
'SBB' )
691 WRITE( nounit, fmt = 9998 )m, n, k, ioldsd, jtype,
702 CALL slasum(
'SBB', nounit, nerrs, ntestt )
705 9999
FORMAT(
' SCHKBB: ', 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 slatmr(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)
SLATMR
subroutine slahd2(IOUNIT, PATH)
SLAHD2
subroutine sort01(ROWCOL, M, N, U, LDU, WORK, LWORK, RESID)
SORT01
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
subroutine sbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RESID)
SBDT01
subroutine sgbbrd(VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, LDQ, PT, LDPT, C, LDC, WORK, INFO)
SGBBRD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine schkbb(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)
SCHKBB
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM
subroutine sbdt02(M, N, B, LDB, C, LDC, U, LDU, WORK, RESID)
SBDT02