290      SUBROUTINE schksb( NSIZES, NN, NWDTHS, KK, NTYPES, DOTYPE, ISEED,
 
  291     $                   THRESH, NOUNIT, A, LDA, SD, SE, U, LDU, WORK,
 
  292     $                   LWORK, RESULT, INFO )
 
  299      INTEGER            INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
 
  305      INTEGER            ISEED( 4 ), KK( * ), NN( * )
 
  306      REAL               A( LDA, * ), RESULT( * ), SD( * ), SE( * ),
 
  307     $                   u( ldu, * ), work( * )
 
  313      REAL               ZERO, ONE, TWO, TEN
 
  314      PARAMETER          ( ZERO = 0.0e0, one = 1.0e0, two = 2.0e0,
 
  317      PARAMETER          ( HALF = one / two )
 
  319      parameter( maxtyp = 15 )
 
  322      LOGICAL            BADNN, BADNNB
 
  323      INTEGER            I, IINFO, IMODE, ITYPE, J, JC, JCOL, JR, JSIZE,
 
  324     $                   jtype, jwidth, k, kmax, mtypes, n, nerrs,
 
  325     $                   nmats, nmax, ntest, ntestt
 
  326      REAL               ANINV, ANORM, COND, OVFL, RTOVFL, RTUNFL,
 
  327     $                   TEMP1, ULP, ULPINV, UNFL
 
  330      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), KMAGN( MAXTYP ),
 
  331     $                   KMODE( MAXTYP ), KTYPE( MAXTYP )
 
  342      INTRINSIC          abs, max, min, real, sqrt
 
  345      DATA               ktype / 1, 2, 5*4, 5*5, 3*8 /
 
  346      DATA               kmagn / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
 
  348      DATA               kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
 
  363         nmax = max( nmax, nn( j ) )
 
  371         kmax = max( kmax, kk( j ) )
 
  375      kmax = min( nmax-1, kmax )
 
  379      IF( nsizes.LT.0 ) 
THEN 
  381      ELSE IF( badnn ) 
THEN 
  383      ELSE IF( nwdths.LT.0 ) 
THEN 
  385      ELSE IF( badnnb ) 
THEN 
  387      ELSE IF( ntypes.LT.0 ) 
THEN 
  389      ELSE IF( lda.LT.kmax+1 ) 
THEN 
  391      ELSE IF( ldu.LT.nmax ) 
THEN 
  393      ELSE IF( ( max( lda, nmax )+1 )*nmax.GT.lwork ) 
THEN 
  398         CALL xerbla( 
'SCHKSB', -info )
 
  404      IF( nsizes.EQ.0 .OR. ntypes.EQ.0 .OR. nwdths.EQ.0 )
 
  409      unfl = slamch( 
'Safe minimum' )
 
  411      ulp = slamch( 
'Epsilon' )*slamch( 
'Base' )
 
  413      rtunfl = sqrt( unfl )
 
  414      rtovfl = sqrt( ovfl )
 
  421      DO 190 jsize = 1, nsizes
 
  423         aninv = one / real( max( 1, n ) )
 
  425         DO 180 jwidth = 1, nwdths
 
  429            k = max( 0, min( n-1, k ) )
 
  431            IF( nsizes.NE.1 ) 
THEN 
  432               mtypes = min( maxtyp, ntypes )
 
  434               mtypes = min( maxtyp+1, ntypes )
 
  437            DO 170 jtype = 1, mtypes
 
  438               IF( .NOT.dotype( jtype ) )
 
  444                  ioldsd( j ) = iseed( j )
 
  464               IF( mtypes.GT.maxtyp )
 
  467               itype = ktype( jtype )
 
  468               imode = kmode( jtype )
 
  472               GO TO ( 40, 50, 60 )kmagn( jtype )
 
  479               anorm = ( rtovfl*ulp )*aninv
 
  483               anorm = rtunfl*n*ulpinv
 
  488               CALL slaset( 
'Full', lda, n, zero, zero, a, lda )
 
  490               IF( jtype.LE.15 ) 
THEN 
  493                  cond = ulpinv*aninv / ten
 
  500               IF( itype.EQ.1 ) 
THEN 
  503               ELSE IF( itype.EQ.2 ) 
THEN 
  508                     a( k+1, jcol ) = anorm
 
  511               ELSE IF( itype.EQ.4 ) 
THEN 
  515                  CALL slatms( n, n, 
'S', iseed, 
'S', work, imode, cond,
 
  516     $                         anorm, 0, 0, 
'Q', a( k+1, 1 ), lda,
 
  517     $                         work( n+1 ), iinfo )
 
  519               ELSE IF( itype.EQ.5 ) 
THEN 
  523                  CALL slatms( n, n, 
'S', iseed, 
'S', work, imode, cond,
 
  524     $                         anorm, k, k, 
'Q', a, lda, work( n+1 ),
 
  527               ELSE IF( itype.EQ.7 ) 
THEN 
  531                  CALL slatmr( n, n, 
'S', iseed, 
'S', work, 6, one, one,
 
  532     $                         
'T', 
'N', work( n+1 ), 1, one,
 
  533     $                         work( 2*n+1 ), 1, one, 
'N', idumma, 0, 0,
 
  534     $                         zero, anorm, 
'Q', a( k+1, 1 ), lda,
 
  537               ELSE IF( itype.EQ.8 ) 
THEN 
  541                  CALL slatmr( n, n, 
'S', iseed, 
'S', work, 6, one, one,
 
  542     $                         
'T', 
'N', work( n+1 ), 1, one,
 
  543     $                         work( 2*n+1 ), 1, one, 
'N', idumma, k, k,
 
  544     $                         zero, anorm, 
'Q', a, lda, idumma, iinfo )
 
  546               ELSE IF( itype.EQ.9 ) 
THEN 
  550                  CALL slatms( n, n, 
'S', iseed, 
'P', work, imode, cond,
 
  551     $                         anorm, k, k, 
'Q', a, lda, work( n+1 ),
 
  554               ELSE IF( itype.EQ.10 ) 
THEN 
  560                  CALL slatms( n, n, 
'S', iseed, 
'P', work, imode, cond,
 
  561     $                         anorm, 1, 1, 
'Q', a( k, 1 ), lda,
 
  562     $                         work( n+1 ), iinfo )
 
  564                     temp1 = abs( a( k, i ) ) /
 
  565     $                       sqrt( abs( a( k+1, i-1 )*a( k+1, i ) ) )
 
  566                     IF( temp1.GT.half ) 
THEN 
  567                        a( k, i ) = half*sqrt( abs( a( k+1,
 
  568     $                              i-1 )*a( k+1, i ) ) )
 
  577               IF( iinfo.NE.0 ) 
THEN 
  578                  WRITE( nounit, fmt = 9999 )
'Generator', iinfo, n,
 
  588               CALL slacpy( 
' ', k+1, n, a, lda, work, lda )
 
  591               CALL ssbtrd( 
'V', 
'U', n, k, work, lda, sd, se, u, ldu,
 
  592     $                      work( lda*n+1 ), iinfo )
 
  594               IF( iinfo.NE.0 ) 
THEN 
  595                  WRITE( nounit, fmt = 9999 )
'SSBTRD(U)', iinfo, n,
 
  598                  IF( iinfo.LT.0 ) 
THEN 
  608               CALL ssbt21( 
'Upper', n, k, 1, a, lda, sd, se, u, ldu,
 
  609     $                      work, result( 1 ) )
 
  615                  DO 110 jr = 0, min( k, n-jc )
 
  616                     a( jr+1, jc ) = a( k+1-jr, jc+jr )
 
  619               DO 140 jc = n + 1 - k, n
 
  620                  DO 130 jr = min( k, n-jc ) + 1, k
 
  627               CALL slacpy( 
' ', k+1, n, a, lda, work, lda )
 
  630               CALL ssbtrd( 
'V', 
'L', n, k, work, lda, sd, se, u, ldu,
 
  631     $                      work( lda*n+1 ), iinfo )
 
  633               IF( iinfo.NE.0 ) 
THEN 
  634                  WRITE( nounit, fmt = 9999 )
'SSBTRD(L)', iinfo, n,
 
  637                  IF( iinfo.LT.0 ) 
THEN 
  648               CALL ssbt21( 
'Lower', n, k, 1, a, lda, sd, se, u, ldu,
 
  649     $                      work, result( 3 ) )
 
  654               ntestt = ntestt + ntest
 
  659                  IF( result( jr ).GE.thresh ) 
THEN 
  664                     IF( nerrs.EQ.0 ) 
THEN 
  665                        WRITE( nounit, fmt = 9998 )
'SSB' 
  666                        WRITE( nounit, fmt = 9997 )
 
  667                        WRITE( nounit, fmt = 9996 )
 
  668                        WRITE( nounit, fmt = 9995 )
'Symmetric' 
  669                        WRITE( nounit, fmt = 9994 )
'orthogonal', 
'''',
 
  670     $                     
'transpose', ( 
'''', j = 1, 4 )
 
  673                     WRITE( nounit, fmt = 9993 )n, k, ioldsd, jtype,
 
  684      CALL slasum( 
'SSB', nounit, nerrs, ntestt )
 
  687 9999 
FORMAT( 
' SCHKSB: ', a, 
' returned INFO=', i6, 
'.', / 9x, 
'N=',
 
  688     $      i6, 
', JTYPE=', i6, 
', ISEED=(', 3( i5, 
',' ), i5, 
')' )
 
  690 9998 
FORMAT( / 1x, a3,
 
  691     $      
' -- Real Symmetric Banded Tridiagonal Reduction Routines' )
 
  692 9997 
FORMAT( 
' Matrix types (see SCHKSB for details): ' )
 
  694 9996 
FORMAT( / 
' Special Matrices:',
 
  695     $      / 
'  1=Zero matrix.                        ',
 
  696     $      
'  5=Diagonal: clustered entries.',
 
  697     $      / 
'  2=Identity matrix.                    ',
 
  698     $      
'  6=Diagonal: large, evenly spaced.',
 
  699     $      / 
'  3=Diagonal: evenly spaced entries.    ',
 
  700     $      
'  7=Diagonal: small, evenly spaced.',
 
  701     $      / 
'  4=Diagonal: geometr. spaced entries.' )
 
  702 9995 
FORMAT( 
' Dense ', a, 
' Banded Matrices:',
 
  703     $      / 
'  8=Evenly spaced eigenvals.            ',
 
  704     $      
' 12=Small, evenly spaced eigenvals.',
 
  705     $      / 
'  9=Geometrically spaced eigenvals.     ',
 
  706     $      
' 13=Matrix with random O(1) entries.',
 
  707     $      / 
' 10=Clustered eigenvalues.              ',
 
  708     $      
' 14=Matrix with large random entries.',
 
  709     $      / 
' 11=Large, evenly spaced eigenvals.     ',
 
  710     $      
' 15=Matrix with small random entries.' )
 
  712 9994 
FORMAT( / 
' Tests performed:   (S is Tridiag,  U is ', a, 
',',
 
  713     $      / 20x, a, 
' means ', a, 
'.', / 
' UPLO=''U'':',
 
  714     $      / 
'  1= | A - U S U', a1, 
' | / ( |A| n ulp )     ',
 
  715     $      
'  2= | I - U U', a1, 
' | / ( n ulp )', / 
' UPLO=''L'':',
 
  716     $      / 
'  3= | A - U S U', a1, 
' | / ( |A| n ulp )     ',
 
  717     $      
'  4= | I - U U', a1, 
' | / ( n ulp )' )
 
  718 9993 
FORMAT( 
' N=', i5, 
', K=', i4, 
', seed=', 4( i4, 
',' ), 
' type ',
 
  719     $      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