 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE DCHKBB( 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 DOUBLE PRECISION THRESH 00014 * .. 00015 * .. Array Arguments .. 00016 LOGICAL DOTYPE( * ) 00017 INTEGER ISEED( 4 ), KK( * ), MVAL( * ), NVAL( * ) 00018 DOUBLE PRECISION 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 * DCHKBB tests the reduction of a general real rectangular band 00027 * matrix to bidiagonal form. 00028 * 00029 * DGBBRD 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 * DGBBRD 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, DCHKBB 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 * DCHKBB 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, DCHKBB 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 DCHKBB to continue the same random number 00145 * sequence. 00146 * 00147 * THRESH (input) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION array, dimension (max(NN)) 00175 * Used to hold the diagonal of the bidiagonal matrix computed 00176 * by DGBBRD. 00177 * 00178 * BE (workspace) DOUBLE PRECISION array, dimension (max(NN)) 00179 * Used to hold the off-diagonal of the bidiagonal matrix 00180 * computed by DGBBRD. 00181 * 00182 * Q (workspace) DOUBLE PRECISION array, dimension (LDQ, max(NN)) 00183 * Used to hold the orthogonal matrix Q computed by DGBBRD. 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) DOUBLE PRECISION array, dimension (LDP, max(NN)) 00190 * Used to hold the orthogonal matrix P computed by DGBBRD. 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) DOUBLE PRECISION array, dimension (LDC, max(NN)) 00197 * Used to hold the matrix C updated by DGBBRD. 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) DOUBLE PRECISION array, dimension (LDC, max(NN)) 00204 * Used to hold a copy of the matrix C. 00205 * 00206 * WORK (workspace) DOUBLE PRECISION 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) DOUBLE PRECISION 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 DOUBLE PRECISION ZERO, ONE 00250 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 00251 INTEGER MAXTYP 00252 PARAMETER ( MAXTYP = 15 ) 00253 * .. 00254 * .. Local Scalars .. 00255 LOGICAL BADMM, BADNN, BADNNB 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 DOUBLE PRECISION 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 DOUBLE PRECISION DLAMCH 00269 EXTERNAL DLAMCH 00270 * .. 00271 * .. External Subroutines .. 00272 EXTERNAL DBDT01, DBDT02, DGBBRD, DLACPY, DLAHD2, DLASET, 00273 $ DLASUM, DLATMR, DLATMS, DORT01, XERBLA 00274 * .. 00275 * .. Intrinsic Functions .. 00276 INTRINSIC ABS, DBLE, MAX, MIN, 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 * 00293 BADMM = .FALSE. 00294 BADNN = .FALSE. 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 ) 00301 $ BADMM = .TRUE. 00302 NMAX = MAX( NMAX, NVAL( J ) ) 00303 IF( NVAL( J ).LT.0 ) 00304 $ BADNN = .TRUE. 00305 MNMAX = MAX( MNMAX, MIN( MVAL( J ), NVAL( J ) ) ) 00306 10 CONTINUE 00307 * 00308 BADNNB = .FALSE. 00309 KMAX = 0 00310 DO 20 J = 1, NWDTHS 00311 KMAX = MAX( KMAX, KK( J ) ) 00312 IF( KK( J ).LT.0 ) 00313 $ BADNNB = .TRUE. 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( 'DCHKBB', -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 = DLAMCH( 'Safe minimum' ) 00359 OVFL = ONE / UNFL 00360 ULP = DLAMCH( 'Epsilon' )*DLAMCH( '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 / DBLE( 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 DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA ) 00439 CALL DLASET( '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 DLATMS( 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 DLATMS( 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 DLATMR( 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 DLATMR( 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 DLACPY( 'Full', M, NRHS, C, LDC, CC, LDC ) 00516 * 00517 * Call DGBBRD to compute B, Q and P, and to update C. 00518 * 00519 CALL DGBBRD( '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 )'DGBBRD', 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 DBDT01( M, N, -1, A, LDA, Q, LDQ, BD, BE, P, LDP, 00540 $ WORK, RESULT( 1 ) ) 00541 CALL DORT01( 'Columns', M, M, Q, LDQ, WORK, LWORK, 00542 $ RESULT( 2 ) ) 00543 CALL DORT01( 'Rows', N, N, P, LDP, WORK, LWORK, 00544 $ RESULT( 3 ) ) 00545 CALL DBDT02( 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 DLAHD2( NOUNIT, 'DBB' ) 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 DLASUM( 'DBB', NOUNIT, NERRS, NTESTT ) 00573 RETURN 00574 * 00575 9999 FORMAT( ' DCHKBB: ', 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 DCHKBB 00582 * 00583 END
1.7.3 
