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