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' )
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 )