LAPACK 3.3.1 Linear Algebra PACKage

# schkbb.f

Go to the documentation of this file.
```00001       SUBROUTINE SCHKBB( NSIZES, MVAL, NVAL, NWDTHS, KK, NTYPES, DOTYPE,
00002      \$                   NRHS, ISEED, THRESH, NOUNIT, A, LDA, AB, LDAB,
00003      \$                   BD, BE, Q, LDQ, P, LDP, C, LDC, CC, WORK,
00004      \$                   LWORK, RESULT, INFO )
00005 *
00006 *  -- LAPACK test routine (release 2.0) --
00007 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00008 *     November 2006
00009 *
00010 *     .. Scalar Arguments ..
00011       INTEGER            INFO, LDA, LDAB, LDC, LDP, LDQ, LWORK, NOUNIT,
00012      \$                   NRHS, NSIZES, NTYPES, NWDTHS
00013       REAL               THRESH
00014 *     ..
00015 *     .. Array Arguments ..
00016       LOGICAL            DOTYPE( * )
00017       INTEGER            ISEED( 4 ), KK( * ), MVAL( * ), NVAL( * )
00018       REAL               A( LDA, * ), AB( LDAB, * ), BD( * ), BE( * ),
00019      \$                   C( LDC, * ), CC( LDC, * ), P( LDP, * ),
00020      \$                   Q( LDQ, * ), RESULT( * ), WORK( * )
00021 *     ..
00022 *
00023 *  Purpose
00024 *  =======
00025 *
00026 *  SCHKBB tests the reduction of a general real rectangular band
00027 *  matrix to bidiagonal form.
00028 *
00029 *  SGBBRD factors a general band matrix A as  Q B P* , where * means
00030 *  transpose, B is upper bidiagonal, and Q and P are orthogonal;
00031 *  SGBBRD can also overwrite a given matrix C with Q* C .
00032 *
00033 *  For each pair of matrix dimensions (M,N) and each selected matrix
00034 *  type, an M by N matrix A and an M by NRHS matrix C are generated.
00035 *  The problem dimensions are as follows
00036 *     A:          M x N
00037 *     Q:          M x M
00038 *     P:          N x N
00039 *     B:          min(M,N) x min(M,N)
00040 *     C:          M x NRHS
00041 *
00042 *  For each generated matrix, 4 tests are performed:
00043 *
00044 *  (1)   | A - Q B PT | / ( |A| max(M,N) ulp ), PT = P'
00045 *
00046 *  (2)   | I - Q' Q | / ( M ulp )
00047 *
00048 *  (3)   | I - PT PT' | / ( N ulp )
00049 *
00050 *  (4)   | Y - Q' C | / ( |Y| max(M,NRHS) ulp ), where Y = Q' C.
00051 *
00052 *  The "types" are specified by a logical array DOTYPE( 1:NTYPES );
00053 *  if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
00054 *  Currently, the list of possible types is:
00055 *
00056 *  The possible matrix types are
00057 *
00058 *  (1)  The zero matrix.
00059 *  (2)  The identity matrix.
00060 *
00061 *  (3)  A diagonal matrix with evenly spaced entries
00062 *       1, ..., ULP  and random signs.
00063 *       (ULP = (first number larger than 1) - 1 )
00064 *  (4)  A diagonal matrix with geometrically spaced entries
00065 *       1, ..., ULP  and random signs.
00066 *  (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
00067 *       and random signs.
00068 *
00069 *  (6)  Same as (3), but multiplied by SQRT( overflow threshold )
00070 *  (7)  Same as (3), but multiplied by SQRT( underflow threshold )
00071 *
00072 *  (8)  A matrix of the form  U D V, where U and V are orthogonal and
00073 *       D has evenly spaced entries 1, ..., ULP with random signs
00074 *       on the diagonal.
00075 *
00076 *  (9)  A matrix of the form  U D V, where U and V are orthogonal and
00077 *       D has geometrically spaced entries 1, ..., ULP with random
00078 *       signs on the diagonal.
00079 *
00080 *  (10) A matrix of the form  U D V, where U and V are orthogonal and
00081 *       D has "clustered" entries 1, ULP,..., ULP with random
00082 *       signs on the diagonal.
00083 *
00084 *  (11) Same as (8), but multiplied by SQRT( overflow threshold )
00085 *  (12) Same as (8), but multiplied by SQRT( underflow threshold )
00086 *
00087 *  (13) Rectangular matrix with random entries chosen from (-1,1).
00088 *  (14) Same as (13), but multiplied by SQRT( overflow threshold )
00089 *  (15) Same as (13), but multiplied by SQRT( underflow threshold )
00090 *
00091 *  Arguments
00092 *  =========
00093 *
00094 *  NSIZES  (input) INTEGER
00095 *          The number of values of M and N contained in the vectors
00096 *          MVAL and NVAL.  The matrix sizes are used in pairs (M,N).
00097 *          If NSIZES is zero, SCHKBB does nothing.  NSIZES must be at
00098 *          least zero.
00099 *
00100 *  MVAL    (input) INTEGER array, dimension (NSIZES)
00101 *          The values of the matrix row dimension M.
00102 *
00103 *  NVAL    (input) INTEGER array, dimension (NSIZES)
00104 *          The values of the matrix column dimension N.
00105 *
00106 *  NWDTHS  (input) INTEGER
00107 *          The number of bandwidths to use.  If it is zero,
00108 *          SCHKBB does nothing.  It must be at least zero.
00109 *
00110 *  KK      (input) INTEGER array, dimension (NWDTHS)
00111 *          An array containing the bandwidths to be used for the band
00112 *          matrices.  The values must be at least zero.
00113 *
00114 *  NTYPES  (input) INTEGER
00115 *          The number of elements in DOTYPE.   If it is zero, SCHKBB
00116 *          does nothing.  It must be at least zero.  If it is MAXTYP+1
00117 *          and NSIZES is 1, then an additional type, MAXTYP+1 is
00118 *          defined, which is to use whatever matrix is in A.  This
00119 *          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
00120 *          DOTYPE(MAXTYP+1) is .TRUE. .
00121 *
00122 *  DOTYPE  (input) LOGICAL array, dimension (NTYPES)
00123 *          If DOTYPE(j) is .TRUE., then for each size in NN a
00124 *          matrix of that size and of type j will be generated.
00125 *          If NTYPES is smaller than the maximum number of types
00126 *          defined (PARAMETER MAXTYP), then types NTYPES+1 through
00127 *          MAXTYP will not be generated.  If NTYPES is larger
00128 *          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
00129 *          will be ignored.
00130 *
00131 *  NRHS    (input) INTEGER
00132 *          The number of columns in the "right-hand side" matrix C.
00133 *          If NRHS = 0, then the operations on the right-hand side will
00134 *          not be tested. NRHS must be at least 0.
00135 *
00136 *  ISEED   (input/output) INTEGER array, dimension (4)
00137 *          On entry ISEED specifies the seed of the random number
00138 *          generator. The array elements should be between 0 and 4095;
00139 *          if not they will be reduced mod 4096.  Also, ISEED(4) must
00140 *          be odd.  The random number generator uses a linear
00141 *          congruential sequence limited to small integers, and so
00142 *          should produce machine independent random numbers. The
00143 *          values of ISEED are changed on exit, and can be used in the
00144 *          next call to SCHKBB to continue the same random number
00145 *          sequence.
00146 *
00147 *  THRESH  (input) REAL
00148 *          A test will count as "failed" if the "error", computed as
00149 *          described above, exceeds THRESH.  Note that the error
00150 *          is scaled to be O(1), so THRESH should be a reasonably
00151 *          small multiple of 1, e.g., 10 or 100.  In particular,
00152 *          it should not depend on the precision (single vs. double)
00153 *          or the size of the matrix.  It must be at least zero.
00154 *
00155 *  NOUNIT  (input) INTEGER
00156 *          The FORTRAN unit number for printing out error messages
00157 *          (e.g., if a routine returns IINFO not equal to 0.)
00158 *
00159 *  A       (input/workspace) REAL array, dimension
00160 *                            (LDA, max(NN))
00161 *          Used to hold the matrix A.
00162 *
00163 *  LDA     (input) INTEGER
00164 *          The leading dimension of A.  It must be at least 1
00165 *          and at least max( NN ).
00166 *
00167 *  AB      (workspace) REAL array, dimension (LDAB, max(NN))
00168 *          Used to hold A in band storage format.
00169 *
00170 *  LDAB    (input) INTEGER
00171 *          The leading dimension of AB.  It must be at least 2 (not 1!)
00172 *          and at least max( KK )+1.
00173 *
00174 *  BD      (workspace) REAL array, dimension (max(NN))
00175 *          Used to hold the diagonal of the bidiagonal matrix computed
00176 *          by SGBBRD.
00177 *
00178 *  BE      (workspace) REAL array, dimension (max(NN))
00179 *          Used to hold the off-diagonal of the bidiagonal matrix
00180 *          computed by SGBBRD.
00181 *
00182 *  Q       (workspace) REAL array, dimension (LDQ, max(NN))
00183 *          Used to hold the orthogonal matrix Q computed by SGBBRD.
00184 *
00185 *  LDQ     (input) INTEGER
00186 *          The leading dimension of Q.  It must be at least 1
00187 *          and at least max( NN ).
00188 *
00189 *  P       (workspace) REAL array, dimension (LDP, max(NN))
00190 *          Used to hold the orthogonal matrix P computed by SGBBRD.
00191 *
00192 *  LDP     (input) INTEGER
00193 *          The leading dimension of P.  It must be at least 1
00194 *          and at least max( NN ).
00195 *
00196 *  C       (workspace) REAL array, dimension (LDC, max(NN))
00197 *          Used to hold the matrix C updated by SGBBRD.
00198 *
00199 *  LDC     (input) INTEGER
00200 *          The leading dimension of U.  It must be at least 1
00201 *          and at least max( NN ).
00202 *
00203 *  CC      (workspace) REAL array, dimension (LDC, max(NN))
00204 *          Used to hold a copy of the matrix C.
00205 *
00206 *  WORK    (workspace) REAL array, dimension (LWORK)
00207 *
00208 *  LWORK   (input) INTEGER
00209 *          The number of entries in WORK.  This must be at least
00210 *          max( LDA+1, max(NN)+1 )*max(NN).
00211 *
00212 *  RESULT  (output) REAL array, dimension (4)
00213 *          The values computed by the tests described above.
00214 *          The values are currently limited to 1/ulp, to avoid
00215 *          overflow.
00216 *
00217 *  INFO    (output) INTEGER
00218 *          If 0, then everything ran OK.
00219 *
00220 *-----------------------------------------------------------------------
00221 *
00222 *       Some Local Variables and Parameters:
00223 *       ---- ----- --------- --- ----------
00224 *       ZERO, ONE       Real 0 and 1.
00225 *       MAXTYP          The number of types defined.
00226 *       NTEST           The number of tests performed, or which can
00227 *                       be performed so far, for the current matrix.
00228 *       NTESTT          The total number of tests performed so far.
00229 *       NMAX            Largest value in NN.
00230 *       NMATS           The number of matrices generated so far.
00231 *       NERRS           The number of tests which have exceeded THRESH
00232 *                       so far.
00233 *       COND, IMODE     Values to be passed to the matrix generators.
00234 *       ANORM           Norm of A; passed to matrix generators.
00235 *
00236 *       OVFL, UNFL      Overflow and underflow thresholds.
00237 *       ULP, ULPINV     Finest relative precision and its inverse.
00238 *       RTOVFL, RTUNFL  Square roots of the previous 2 values.
00239 *               The following four arrays decode JTYPE:
00240 *       KTYPE(j)        The general type (1-10) for type "j".
00241 *       KMODE(j)        The MODE value to be passed to the matrix
00242 *                       generator for type "j".
00243 *       KMAGN(j)        The order of magnitude ( O(1),
00244 *                       O(overflow^(1/2) ), O(underflow^(1/2) )
00245 *
00246 *  =====================================================================
00247 *
00248 *     .. Parameters ..
00249       REAL               ZERO, ONE
00250       PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
00251       INTEGER            MAXTYP
00252       PARAMETER          ( MAXTYP = 15 )
00253 *     ..
00254 *     .. Local Scalars ..
00256       INTEGER            I, IINFO, IMODE, ITYPE, J, JCOL, JR, JSIZE,
00257      \$                   JTYPE, JWIDTH, K, KL, KMAX, KU, M, MMAX, MNMAX,
00258      \$                   MNMIN, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
00259      \$                   NTESTT
00260       REAL               AMNINV, ANORM, COND, OVFL, RTOVFL, RTUNFL, ULP,
00261      \$                   ULPINV, UNFL
00262 *     ..
00263 *     .. Local Arrays ..
00264       INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), KMAGN( MAXTYP ),
00265      \$                   KMODE( MAXTYP ), KTYPE( MAXTYP )
00266 *     ..
00267 *     .. External Functions ..
00268       REAL               SLAMCH
00269       EXTERNAL           SLAMCH
00270 *     ..
00271 *     .. External Subroutines ..
00272       EXTERNAL           SBDT01, SBDT02, SGBBRD, SLACPY, SLAHD2, SLASET,
00273      \$                   SLASUM, SLATMR, SLATMS, SORT01, XERBLA
00274 *     ..
00275 *     .. Intrinsic Functions ..
00276       INTRINSIC          ABS, MAX, MIN, REAL, SQRT
00277 *     ..
00278 *     .. Data statements ..
00279       DATA               KTYPE / 1, 2, 5*4, 5*6, 3*9 /
00280       DATA               KMAGN / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3 /
00281       DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
00282      \$                   0, 0 /
00283 *     ..
00284 *     .. Executable Statements ..
00285 *
00286 *     Check for errors
00287 *
00288       NTESTT = 0
00289       INFO = 0
00290 *
00291 *     Important constants
00292 *
00295       MMAX = 1
00296       NMAX = 1
00297       MNMAX = 1
00298       DO 10 J = 1, NSIZES
00299          MMAX = MAX( MMAX, MVAL( J ) )
00300          IF( MVAL( J ).LT.0 )
00302          NMAX = MAX( NMAX, NVAL( J ) )
00303          IF( NVAL( J ).LT.0 )
00305          MNMAX = MAX( MNMAX, MIN( MVAL( J ), NVAL( J ) ) )
00306    10 CONTINUE
00307 *
00309       KMAX = 0
00310       DO 20 J = 1, NWDTHS
00311          KMAX = MAX( KMAX, KK( J ) )
00312          IF( KK( J ).LT.0 )
00314    20 CONTINUE
00315 *
00316 *     Check for errors
00317 *
00318       IF( NSIZES.LT.0 ) THEN
00319          INFO = -1
00320       ELSE IF( BADMM ) THEN
00321          INFO = -2
00322       ELSE IF( BADNN ) THEN
00323          INFO = -3
00324       ELSE IF( NWDTHS.LT.0 ) THEN
00325          INFO = -4
00326       ELSE IF( BADNNB ) THEN
00327          INFO = -5
00328       ELSE IF( NTYPES.LT.0 ) THEN
00329          INFO = -6
00330       ELSE IF( NRHS.LT.0 ) THEN
00331          INFO = -8
00332       ELSE IF( LDA.LT.NMAX ) THEN
00333          INFO = -13
00334       ELSE IF( LDAB.LT.2*KMAX+1 ) THEN
00335          INFO = -15
00336       ELSE IF( LDQ.LT.NMAX ) THEN
00337          INFO = -19
00338       ELSE IF( LDP.LT.NMAX ) THEN
00339          INFO = -21
00340       ELSE IF( LDC.LT.NMAX ) THEN
00341          INFO = -23
00342       ELSE IF( ( MAX( LDA, NMAX )+1 )*NMAX.GT.LWORK ) THEN
00343          INFO = -26
00344       END IF
00345 *
00346       IF( INFO.NE.0 ) THEN
00347          CALL XERBLA( 'SCHKBB', -INFO )
00348          RETURN
00349       END IF
00350 *
00351 *     Quick return if possible
00352 *
00353       IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 .OR. NWDTHS.EQ.0 )
00354      \$   RETURN
00355 *
00356 *     More Important constants
00357 *
00358       UNFL = SLAMCH( 'Safe minimum' )
00359       OVFL = ONE / UNFL
00360       ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
00361       ULPINV = ONE / ULP
00362       RTUNFL = SQRT( UNFL )
00363       RTOVFL = SQRT( OVFL )
00364 *
00365 *     Loop over sizes, widths, types
00366 *
00367       NERRS = 0
00368       NMATS = 0
00369 *
00370       DO 160 JSIZE = 1, NSIZES
00371          M = MVAL( JSIZE )
00372          N = NVAL( JSIZE )
00373          MNMIN = MIN( M, N )
00374          AMNINV = ONE / REAL( MAX( 1, M, N ) )
00375 *
00376          DO 150 JWIDTH = 1, NWDTHS
00377             K = KK( JWIDTH )
00378             IF( K.GE.M .AND. K.GE.N )
00379      \$         GO TO 150
00380             KL = MAX( 0, MIN( M-1, K ) )
00381             KU = MAX( 0, MIN( N-1, K ) )
00382 *
00383             IF( NSIZES.NE.1 ) THEN
00384                MTYPES = MIN( MAXTYP, NTYPES )
00385             ELSE
00386                MTYPES = MIN( MAXTYP+1, NTYPES )
00387             END IF
00388 *
00389             DO 140 JTYPE = 1, MTYPES
00390                IF( .NOT.DOTYPE( JTYPE ) )
00391      \$            GO TO 140
00392                NMATS = NMATS + 1
00393                NTEST = 0
00394 *
00395                DO 30 J = 1, 4
00396                   IOLDSD( J ) = ISEED( J )
00397    30          CONTINUE
00398 *
00399 *              Compute "A".
00400 *
00401 *              Control parameters:
00402 *
00403 *                  KMAGN  KMODE        KTYPE
00404 *              =1  O(1)   clustered 1  zero
00405 *              =2  large  clustered 2  identity
00406 *              =3  small  exponential  (none)
00407 *              =4         arithmetic   diagonal, (w/ singular values)
00408 *              =5         random log   (none)
00409 *              =6         random       nonhermitian, w/ singular values
00410 *              =7                      (none)
00411 *              =8                      (none)
00412 *              =9                      random nonhermitian
00413 *
00414                IF( MTYPES.GT.MAXTYP )
00415      \$            GO TO 90
00416 *
00417                ITYPE = KTYPE( JTYPE )
00418                IMODE = KMODE( JTYPE )
00419 *
00420 *              Compute norm
00421 *
00422                GO TO ( 40, 50, 60 )KMAGN( JTYPE )
00423 *
00424    40          CONTINUE
00425                ANORM = ONE
00426                GO TO 70
00427 *
00428    50          CONTINUE
00429                ANORM = ( RTOVFL*ULP )*AMNINV
00430                GO TO 70
00431 *
00432    60          CONTINUE
00433                ANORM = RTUNFL*MAX( M, N )*ULPINV
00434                GO TO 70
00435 *
00436    70          CONTINUE
00437 *
00438                CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
00439                CALL SLASET( 'Full', LDAB, N, ZERO, ZERO, AB, LDAB )
00440                IINFO = 0
00441                COND = ULPINV
00442 *
00443 *              Special Matrices -- Identity & Jordan block
00444 *
00445 *                 Zero
00446 *
00447                IF( ITYPE.EQ.1 ) THEN
00448                   IINFO = 0
00449 *
00450                ELSE IF( ITYPE.EQ.2 ) THEN
00451 *
00452 *                 Identity
00453 *
00454                   DO 80 JCOL = 1, N
00455                      A( JCOL, JCOL ) = ANORM
00456    80             CONTINUE
00457 *
00458                ELSE IF( ITYPE.EQ.4 ) THEN
00459 *
00460 *                 Diagonal Matrix, singular values specified
00461 *
00462                   CALL SLATMS( M, N, 'S', ISEED, 'N', WORK, IMODE, COND,
00463      \$                         ANORM, 0, 0, 'N', A, LDA, WORK( M+1 ),
00464      \$                         IINFO )
00465 *
00466                ELSE IF( ITYPE.EQ.6 ) THEN
00467 *
00468 *                 Nonhermitian, singular values specified
00469 *
00470                   CALL SLATMS( M, N, 'S', ISEED, 'N', WORK, IMODE, COND,
00471      \$                         ANORM, KL, KU, 'N', A, LDA, WORK( M+1 ),
00472      \$                         IINFO )
00473 *
00474                ELSE IF( ITYPE.EQ.9 ) THEN
00475 *
00476 *                 Nonhermitian, random entries
00477 *
00478                   CALL SLATMR( M, N, 'S', ISEED, 'N', WORK, 6, ONE, ONE,
00479      \$                         'T', 'N', WORK( N+1 ), 1, ONE,
00480      \$                         WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, KL,
00481      \$                         KU, ZERO, ANORM, 'N', A, LDA, IDUMMA,
00482      \$                         IINFO )
00483 *
00484                ELSE
00485 *
00486                   IINFO = 1
00487                END IF
00488 *
00489 *              Generate Right-Hand Side
00490 *
00491                CALL SLATMR( M, NRHS, 'S', ISEED, 'N', WORK, 6, ONE, ONE,
00492      \$                      'T', 'N', WORK( M+1 ), 1, ONE,
00493      \$                      WORK( 2*M+1 ), 1, ONE, 'N', IDUMMA, M, NRHS,
00494      \$                      ZERO, ONE, 'NO', C, LDC, IDUMMA, IINFO )
00495 *
00496                IF( IINFO.NE.0 ) THEN
00497                   WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N,
00498      \$               JTYPE, IOLDSD
00499                   INFO = ABS( IINFO )
00500                   RETURN
00501                END IF
00502 *
00503    90          CONTINUE
00504 *
00505 *              Copy A to band storage.
00506 *
00507                DO 110 J = 1, N
00508                   DO 100 I = MAX( 1, J-KU ), MIN( M, J+KL )
00509                      AB( KU+1+I-J, J ) = A( I, J )
00510   100             CONTINUE
00511   110          CONTINUE
00512 *
00513 *              Copy C
00514 *
00515                CALL SLACPY( 'Full', M, NRHS, C, LDC, CC, LDC )
00516 *
00517 *              Call SGBBRD to compute B, Q and P, and to update C.
00518 *
00519                CALL SGBBRD( 'B', M, N, NRHS, KL, KU, AB, LDAB, BD, BE,
00520      \$                      Q, LDQ, P, LDP, CC, LDC, WORK, IINFO )
00521 *
00522                IF( IINFO.NE.0 ) THEN
00523                   WRITE( NOUNIT, FMT = 9999 )'SGBBRD', IINFO, N, JTYPE,
00524      \$               IOLDSD
00525                   INFO = ABS( IINFO )
00526                   IF( IINFO.LT.0 ) THEN
00527                      RETURN
00528                   ELSE
00529                      RESULT( 1 ) = ULPINV
00530                      GO TO 120
00531                   END IF
00532                END IF
00533 *
00534 *              Test 1:  Check the decomposition A := Q * B * P'
00535 *                   2:  Check the orthogonality of Q
00536 *                   3:  Check the orthogonality of P
00537 *                   4:  Check the computation of Q' * C
00538 *
00539                CALL SBDT01( M, N, -1, A, LDA, Q, LDQ, BD, BE, P, LDP,
00540      \$                      WORK, RESULT( 1 ) )
00541                CALL SORT01( 'Columns', M, M, Q, LDQ, WORK, LWORK,
00542      \$                      RESULT( 2 ) )
00543                CALL SORT01( 'Rows', N, N, P, LDP, WORK, LWORK,
00544      \$                      RESULT( 3 ) )
00545                CALL SBDT02( M, NRHS, C, LDC, CC, LDC, Q, LDQ, WORK,
00546      \$                      RESULT( 4 ) )
00547 *
00548 *              End of Loop -- Check for RESULT(j) > THRESH
00549 *
00550                NTEST = 4
00551   120          CONTINUE
00552                NTESTT = NTESTT + NTEST
00553 *
00554 *              Print out tests which fail.
00555 *
00556                DO 130 JR = 1, NTEST
00557                   IF( RESULT( JR ).GE.THRESH ) THEN
00558                      IF( NERRS.EQ.0 )
00559      \$                  CALL SLAHD2( NOUNIT, 'SBB' )
00560                      NERRS = NERRS + 1
00561                      WRITE( NOUNIT, FMT = 9998 )M, N, K, IOLDSD, JTYPE,
00562      \$                  JR, RESULT( JR )
00563                   END IF
00564   130          CONTINUE
00565 *
00566   140       CONTINUE
00567   150    CONTINUE
00568   160 CONTINUE
00569 *
00570 *     Summary
00571 *
00572       CALL SLASUM( 'SBB', NOUNIT, NERRS, NTESTT )
00573       RETURN
00574 *
00575  9999 FORMAT( ' SCHKBB: ', A, ' returned INFO=', I5, '.', / 9X, 'M=',
00576      \$      I5, ' N=', I5, ' K=', I5, ', JTYPE=', I5, ', ISEED=(',
00577      \$      3( I5, ',' ), I5, ')' )
00578  9998 FORMAT( ' M =', I4, ' N=', I4, ', K=', I3, ', seed=',
00579      \$      4( I4, ',' ), ' type ', I2, ', test(', I2, ')=', G10.3 )
00580 *
00581 *     End of SCHKBB
00582 *
00583       END
```