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