![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DCHKBD 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE DCHKBD( NSIZES, MVAL, NVAL, NTYPES, DOTYPE, NRHS, 00012 * ISEED, THRESH, A, LDA, BD, BE, S1, S2, X, LDX, 00013 * Y, Z, Q, LDQ, PT, LDPT, U, VT, WORK, LWORK, 00014 * IWORK, NOUT, INFO ) 00015 * 00016 * .. Scalar Arguments .. 00017 * INTEGER INFO, LDA, LDPT, LDQ, LDX, LWORK, NOUT, NRHS, 00018 * $ NSIZES, NTYPES 00019 * DOUBLE PRECISION THRESH 00020 * .. 00021 * .. Array Arguments .. 00022 * LOGICAL DOTYPE( * ) 00023 * INTEGER ISEED( 4 ), IWORK( * ), MVAL( * ), NVAL( * ) 00024 * DOUBLE PRECISION A( LDA, * ), BD( * ), BE( * ), PT( LDPT, * ), 00025 * $ Q( LDQ, * ), S1( * ), S2( * ), U( LDPT, * ), 00026 * $ VT( LDPT, * ), WORK( * ), X( LDX, * ), 00027 * $ Y( LDX, * ), Z( LDX, * ) 00028 * .. 00029 * 00030 * 00031 *> \par Purpose: 00032 * ============= 00033 *> 00034 *> \verbatim 00035 *> 00036 *> DCHKBD checks the singular value decomposition (SVD) routines. 00037 *> 00038 *> DGEBRD reduces a real general m by n matrix A to upper or lower 00039 *> bidiagonal form B by an orthogonal transformation: Q' * A * P = B 00040 *> (or A = Q * B * P'). The matrix B is upper bidiagonal if m >= n 00041 *> and lower bidiagonal if m < n. 00042 *> 00043 *> DORGBR generates the orthogonal matrices Q and P' from DGEBRD. 00044 *> Note that Q and P are not necessarily square. 00045 *> 00046 *> DBDSQR computes the singular value decomposition of the bidiagonal 00047 *> matrix B as B = U S V'. It is called three times to compute 00048 *> 1) B = U S1 V', where S1 is the diagonal matrix of singular 00049 *> values and the columns of the matrices U and V are the left 00050 *> and right singular vectors, respectively, of B. 00051 *> 2) Same as 1), but the singular values are stored in S2 and the 00052 *> singular vectors are not computed. 00053 *> 3) A = (UQ) S (P'V'), the SVD of the original matrix A. 00054 *> In addition, DBDSQR has an option to apply the left orthogonal matrix 00055 *> U to a matrix X, useful in least squares applications. 00056 *> 00057 *> DBDSDC computes the singular value decomposition of the bidiagonal 00058 *> matrix B as B = U S V' using divide-and-conquer. It is called twice 00059 *> to compute 00060 *> 1) B = U S1 V', where S1 is the diagonal matrix of singular 00061 *> values and the columns of the matrices U and V are the left 00062 *> and right singular vectors, respectively, of B. 00063 *> 2) Same as 1), but the singular values are stored in S2 and the 00064 *> singular vectors are not computed. 00065 *> 00066 *> For each pair of matrix dimensions (M,N) and each selected matrix 00067 *> type, an M by N matrix A and an M by NRHS matrix X are generated. 00068 *> The problem dimensions are as follows 00069 *> A: M x N 00070 *> Q: M x min(M,N) (but M x M if NRHS > 0) 00071 *> P: min(M,N) x N 00072 *> B: min(M,N) x min(M,N) 00073 *> U, V: min(M,N) x min(M,N) 00074 *> S1, S2 diagonal, order min(M,N) 00075 *> X: M x NRHS 00076 *> 00077 *> For each generated matrix, 14 tests are performed: 00078 *> 00079 *> Test DGEBRD and DORGBR 00080 *> 00081 *> (1) | A - Q B PT | / ( |A| max(M,N) ulp ), PT = P' 00082 *> 00083 *> (2) | I - Q' Q | / ( M ulp ) 00084 *> 00085 *> (3) | I - PT PT' | / ( N ulp ) 00086 *> 00087 *> Test DBDSQR on bidiagonal matrix B 00088 *> 00089 *> (4) | B - U S1 VT | / ( |B| min(M,N) ulp ), VT = V' 00090 *> 00091 *> (5) | Y - U Z | / ( |Y| max(min(M,N),k) ulp ), where Y = Q' X 00092 *> and Z = U' Y. 00093 *> (6) | I - U' U | / ( min(M,N) ulp ) 00094 *> 00095 *> (7) | I - VT VT' | / ( min(M,N) ulp ) 00096 *> 00097 *> (8) S1 contains min(M,N) nonnegative values in decreasing order. 00098 *> (Return 0 if true, 1/ULP if false.) 00099 *> 00100 *> (9) | S1 - S2 | / ( |S1| ulp ), where S2 is computed without 00101 *> computing U and V. 00102 *> 00103 *> (10) 0 if the true singular values of B are within THRESH of 00104 *> those in S1. 2*THRESH if they are not. (Tested using 00105 *> DSVDCH) 00106 *> 00107 *> Test DBDSQR on matrix A 00108 *> 00109 *> (11) | A - (QU) S (VT PT) | / ( |A| max(M,N) ulp ) 00110 *> 00111 *> (12) | X - (QU) Z | / ( |X| max(M,k) ulp ) 00112 *> 00113 *> (13) | I - (QU)'(QU) | / ( M ulp ) 00114 *> 00115 *> (14) | I - (VT PT) (PT'VT') | / ( N ulp ) 00116 *> 00117 *> Test DBDSDC on bidiagonal matrix B 00118 *> 00119 *> (15) | B - U S1 VT | / ( |B| min(M,N) ulp ), VT = V' 00120 *> 00121 *> (16) | I - U' U | / ( min(M,N) ulp ) 00122 *> 00123 *> (17) | I - VT VT' | / ( min(M,N) ulp ) 00124 *> 00125 *> (18) S1 contains min(M,N) nonnegative values in decreasing order. 00126 *> (Return 0 if true, 1/ULP if false.) 00127 *> 00128 *> (19) | S1 - S2 | / ( |S1| ulp ), where S2 is computed without 00129 *> computing U and V. 00130 *> The possible matrix types are 00131 *> 00132 *> (1) The zero matrix. 00133 *> (2) The identity matrix. 00134 *> 00135 *> (3) A diagonal matrix with evenly spaced entries 00136 *> 1, ..., ULP and random signs. 00137 *> (ULP = (first number larger than 1) - 1 ) 00138 *> (4) A diagonal matrix with geometrically spaced entries 00139 *> 1, ..., ULP and random signs. 00140 *> (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP 00141 *> and random signs. 00142 *> 00143 *> (6) Same as (3), but multiplied by SQRT( overflow threshold ) 00144 *> (7) Same as (3), but multiplied by SQRT( underflow threshold ) 00145 *> 00146 *> (8) A matrix of the form U D V, where U and V are orthogonal and 00147 *> D has evenly spaced entries 1, ..., ULP with random signs 00148 *> on the diagonal. 00149 *> 00150 *> (9) A matrix of the form U D V, where U and V are orthogonal and 00151 *> D has geometrically spaced entries 1, ..., ULP with random 00152 *> signs on the diagonal. 00153 *> 00154 *> (10) A matrix of the form U D V, where U and V are orthogonal and 00155 *> D has "clustered" entries 1, ULP,..., ULP with random 00156 *> signs on the diagonal. 00157 *> 00158 *> (11) Same as (8), but multiplied by SQRT( overflow threshold ) 00159 *> (12) Same as (8), but multiplied by SQRT( underflow threshold ) 00160 *> 00161 *> (13) Rectangular matrix with random entries chosen from (-1,1). 00162 *> (14) Same as (13), but multiplied by SQRT( overflow threshold ) 00163 *> (15) Same as (13), but multiplied by SQRT( underflow threshold ) 00164 *> 00165 *> Special case: 00166 *> (16) A bidiagonal matrix with random entries chosen from a 00167 *> logarithmic distribution on [ulp^2,ulp^(-2)] (I.e., each 00168 *> entry is e^x, where x is chosen uniformly on 00169 *> [ 2 log(ulp), -2 log(ulp) ] .) For *this* type: 00170 *> (a) DGEBRD is not called to reduce it to bidiagonal form. 00171 *> (b) the bidiagonal is min(M,N) x min(M,N); if M<N, the 00172 *> matrix will be lower bidiagonal, otherwise upper. 00173 *> (c) only tests 5--8 and 14 are performed. 00174 *> 00175 *> A subset of the full set of matrix types may be selected through 00176 *> the logical array DOTYPE. 00177 *> \endverbatim 00178 * 00179 * Arguments: 00180 * ========== 00181 * 00182 *> \param[in] NSIZES 00183 *> \verbatim 00184 *> NSIZES is INTEGER 00185 *> The number of values of M and N contained in the vectors 00186 *> MVAL and NVAL. The matrix sizes are used in pairs (M,N). 00187 *> \endverbatim 00188 *> 00189 *> \param[in] MVAL 00190 *> \verbatim 00191 *> MVAL is INTEGER array, dimension (NM) 00192 *> The values of the matrix row dimension M. 00193 *> \endverbatim 00194 *> 00195 *> \param[in] NVAL 00196 *> \verbatim 00197 *> NVAL is INTEGER array, dimension (NM) 00198 *> The values of the matrix column dimension N. 00199 *> \endverbatim 00200 *> 00201 *> \param[in] NTYPES 00202 *> \verbatim 00203 *> NTYPES is INTEGER 00204 *> The number of elements in DOTYPE. If it is zero, DCHKBD 00205 *> does nothing. It must be at least zero. If it is MAXTYP+1 00206 *> and NSIZES is 1, then an additional type, MAXTYP+1 is 00207 *> defined, which is to use whatever matrices are in A and B. 00208 *> This is only useful if DOTYPE(1:MAXTYP) is .FALSE. and 00209 *> DOTYPE(MAXTYP+1) is .TRUE. . 00210 *> \endverbatim 00211 *> 00212 *> \param[in] DOTYPE 00213 *> \verbatim 00214 *> DOTYPE is LOGICAL array, dimension (NTYPES) 00215 *> If DOTYPE(j) is .TRUE., then for each size (m,n), a matrix 00216 *> of type j will be generated. If NTYPES is smaller than the 00217 *> maximum number of types defined (PARAMETER MAXTYP), then 00218 *> types NTYPES+1 through MAXTYP will not be generated. If 00219 *> NTYPES is larger than MAXTYP, DOTYPE(MAXTYP+1) through 00220 *> DOTYPE(NTYPES) will be ignored. 00221 *> \endverbatim 00222 *> 00223 *> \param[in] NRHS 00224 *> \verbatim 00225 *> NRHS is INTEGER 00226 *> The number of columns in the "right-hand side" matrices X, Y, 00227 *> and Z, used in testing DBDSQR. If NRHS = 0, then the 00228 *> operations on the right-hand side will not be tested. 00229 *> NRHS must be at least 0. 00230 *> \endverbatim 00231 *> 00232 *> \param[in,out] ISEED 00233 *> \verbatim 00234 *> ISEED is INTEGER array, dimension (4) 00235 *> On entry ISEED specifies the seed of the random number 00236 *> generator. The array elements should be between 0 and 4095; 00237 *> if not they will be reduced mod 4096. Also, ISEED(4) must 00238 *> be odd. The values of ISEED are changed on exit, and can be 00239 *> used in the next call to DCHKBD to continue the same random 00240 *> number sequence. 00241 *> \endverbatim 00242 *> 00243 *> \param[in] THRESH 00244 *> \verbatim 00245 *> THRESH is DOUBLE PRECISION 00246 *> The threshold value for the test ratios. A result is 00247 *> included in the output file if RESULT >= THRESH. To have 00248 *> every test ratio printed, use THRESH = 0. Note that the 00249 *> expected value of the test ratios is O(1), so THRESH should 00250 *> be a reasonably small multiple of 1, e.g., 10 or 100. 00251 *> \endverbatim 00252 *> 00253 *> \param[out] A 00254 *> \verbatim 00255 *> A is DOUBLE PRECISION array, dimension (LDA,NMAX) 00256 *> where NMAX is the maximum value of N in NVAL. 00257 *> \endverbatim 00258 *> 00259 *> \param[in] LDA 00260 *> \verbatim 00261 *> LDA is INTEGER 00262 *> The leading dimension of the array A. LDA >= max(1,MMAX), 00263 *> where MMAX is the maximum value of M in MVAL. 00264 *> \endverbatim 00265 *> 00266 *> \param[out] BD 00267 *> \verbatim 00268 *> BD is DOUBLE PRECISION array, dimension 00269 *> (max(min(MVAL(j),NVAL(j)))) 00270 *> \endverbatim 00271 *> 00272 *> \param[out] BE 00273 *> \verbatim 00274 *> BE is DOUBLE PRECISION array, dimension 00275 *> (max(min(MVAL(j),NVAL(j)))) 00276 *> \endverbatim 00277 *> 00278 *> \param[out] S1 00279 *> \verbatim 00280 *> S1 is DOUBLE PRECISION array, dimension 00281 *> (max(min(MVAL(j),NVAL(j)))) 00282 *> \endverbatim 00283 *> 00284 *> \param[out] S2 00285 *> \verbatim 00286 *> S2 is DOUBLE PRECISION array, dimension 00287 *> (max(min(MVAL(j),NVAL(j)))) 00288 *> \endverbatim 00289 *> 00290 *> \param[out] X 00291 *> \verbatim 00292 *> X is DOUBLE PRECISION array, dimension (LDX,NRHS) 00293 *> \endverbatim 00294 *> 00295 *> \param[in] LDX 00296 *> \verbatim 00297 *> LDX is INTEGER 00298 *> The leading dimension of the arrays X, Y, and Z. 00299 *> LDX >= max(1,MMAX) 00300 *> \endverbatim 00301 *> 00302 *> \param[out] Y 00303 *> \verbatim 00304 *> Y is DOUBLE PRECISION array, dimension (LDX,NRHS) 00305 *> \endverbatim 00306 *> 00307 *> \param[out] Z 00308 *> \verbatim 00309 *> Z is DOUBLE PRECISION array, dimension (LDX,NRHS) 00310 *> \endverbatim 00311 *> 00312 *> \param[out] Q 00313 *> \verbatim 00314 *> Q is DOUBLE PRECISION array, dimension (LDQ,MMAX) 00315 *> \endverbatim 00316 *> 00317 *> \param[in] LDQ 00318 *> \verbatim 00319 *> LDQ is INTEGER 00320 *> The leading dimension of the array Q. LDQ >= max(1,MMAX). 00321 *> \endverbatim 00322 *> 00323 *> \param[out] PT 00324 *> \verbatim 00325 *> PT is DOUBLE PRECISION array, dimension (LDPT,NMAX) 00326 *> \endverbatim 00327 *> 00328 *> \param[in] LDPT 00329 *> \verbatim 00330 *> LDPT is INTEGER 00331 *> The leading dimension of the arrays PT, U, and V. 00332 *> LDPT >= max(1, max(min(MVAL(j),NVAL(j)))). 00333 *> \endverbatim 00334 *> 00335 *> \param[out] U 00336 *> \verbatim 00337 *> U is DOUBLE PRECISION array, dimension 00338 *> (LDPT,max(min(MVAL(j),NVAL(j)))) 00339 *> \endverbatim 00340 *> 00341 *> \param[out] VT 00342 *> \verbatim 00343 *> VT is DOUBLE PRECISION array, dimension 00344 *> (LDPT,max(min(MVAL(j),NVAL(j)))) 00345 *> \endverbatim 00346 *> 00347 *> \param[out] WORK 00348 *> \verbatim 00349 *> WORK is DOUBLE PRECISION array, dimension (LWORK) 00350 *> \endverbatim 00351 *> 00352 *> \param[in] LWORK 00353 *> \verbatim 00354 *> LWORK is INTEGER 00355 *> The number of entries in WORK. This must be at least 00356 *> 3(M+N) and M(M + max(M,N,k) + 1) + N*min(M,N) for all 00357 *> pairs (M,N)=(MM(j),NN(j)) 00358 *> \endverbatim 00359 *> 00360 *> \param[out] IWORK 00361 *> \verbatim 00362 *> IWORK is INTEGER array, dimension at least 8*min(M,N) 00363 *> \endverbatim 00364 *> 00365 *> \param[in] NOUT 00366 *> \verbatim 00367 *> NOUT is INTEGER 00368 *> The FORTRAN unit number for printing out error messages 00369 *> (e.g., if a routine returns IINFO not equal to 0.) 00370 *> \endverbatim 00371 *> 00372 *> \param[out] INFO 00373 *> \verbatim 00374 *> INFO is INTEGER 00375 *> If 0, then everything ran OK. 00376 *> -1: NSIZES < 0 00377 *> -2: Some MM(j) < 0 00378 *> -3: Some NN(j) < 0 00379 *> -4: NTYPES < 0 00380 *> -6: NRHS < 0 00381 *> -8: THRESH < 0 00382 *> -11: LDA < 1 or LDA < MMAX, where MMAX is max( MM(j) ). 00383 *> -17: LDB < 1 or LDB < MMAX. 00384 *> -21: LDQ < 1 or LDQ < MMAX. 00385 *> -23: LDPT< 1 or LDPT< MNMAX. 00386 *> -27: LWORK too small. 00387 *> If DLATMR, SLATMS, DGEBRD, DORGBR, or DBDSQR, 00388 *> returns an error code, the 00389 *> absolute value of it is returned. 00390 *> 00391 *>----------------------------------------------------------------------- 00392 *> 00393 *> Some Local Variables and Parameters: 00394 *> ---- ----- --------- --- ---------- 00395 *> 00396 *> ZERO, ONE Real 0 and 1. 00397 *> MAXTYP The number of types defined. 00398 *> NTEST The number of tests performed, or which can 00399 *> be performed so far, for the current matrix. 00400 *> MMAX Largest value in NN. 00401 *> NMAX Largest value in NN. 00402 *> MNMIN min(MM(j), NN(j)) (the dimension of the bidiagonal 00403 *> matrix.) 00404 *> MNMAX The maximum value of MNMIN for j=1,...,NSIZES. 00405 *> NFAIL The number of tests which have exceeded THRESH 00406 *> COND, IMODE Values to be passed to the matrix generators. 00407 *> ANORM Norm of A; passed to matrix generators. 00408 *> 00409 *> OVFL, UNFL Overflow and underflow thresholds. 00410 *> RTOVFL, RTUNFL Square roots of the previous 2 values. 00411 *> ULP, ULPINV Finest relative precision and its inverse. 00412 *> 00413 *> The following four arrays decode JTYPE: 00414 *> KTYPE(j) The general type (1-10) for type "j". 00415 *> KMODE(j) The MODE value to be passed to the matrix 00416 *> generator for type "j". 00417 *> KMAGN(j) The order of magnitude ( O(1), 00418 *> O(overflow^(1/2) ), O(underflow^(1/2) ) 00419 *> \endverbatim 00420 * 00421 * Authors: 00422 * ======== 00423 * 00424 *> \author Univ. of Tennessee 00425 *> \author Univ. of California Berkeley 00426 *> \author Univ. of Colorado Denver 00427 *> \author NAG Ltd. 00428 * 00429 *> \date November 2011 00430 * 00431 *> \ingroup double_eig 00432 * 00433 * ===================================================================== 00434 SUBROUTINE DCHKBD( NSIZES, MVAL, NVAL, NTYPES, DOTYPE, NRHS, 00435 $ ISEED, THRESH, A, LDA, BD, BE, S1, S2, X, LDX, 00436 $ Y, Z, Q, LDQ, PT, LDPT, U, VT, WORK, LWORK, 00437 $ IWORK, NOUT, INFO ) 00438 * 00439 * -- LAPACK test routine (version 3.4.0) -- 00440 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00441 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00442 * November 2011 00443 * 00444 * .. Scalar Arguments .. 00445 INTEGER INFO, LDA, LDPT, LDQ, LDX, LWORK, NOUT, NRHS, 00446 $ NSIZES, NTYPES 00447 DOUBLE PRECISION THRESH 00448 * .. 00449 * .. Array Arguments .. 00450 LOGICAL DOTYPE( * ) 00451 INTEGER ISEED( 4 ), IWORK( * ), MVAL( * ), NVAL( * ) 00452 DOUBLE PRECISION A( LDA, * ), BD( * ), BE( * ), PT( LDPT, * ), 00453 $ Q( LDQ, * ), S1( * ), S2( * ), U( LDPT, * ), 00454 $ VT( LDPT, * ), WORK( * ), X( LDX, * ), 00455 $ Y( LDX, * ), Z( LDX, * ) 00456 * .. 00457 * 00458 * ====================================================================== 00459 * 00460 * .. Parameters .. 00461 DOUBLE PRECISION ZERO, ONE, TWO, HALF 00462 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0, 00463 $ HALF = 0.5D0 ) 00464 INTEGER MAXTYP 00465 PARAMETER ( MAXTYP = 16 ) 00466 * .. 00467 * .. Local Scalars .. 00468 LOGICAL BADMM, BADNN, BIDIAG 00469 CHARACTER UPLO 00470 CHARACTER*3 PATH 00471 INTEGER I, IINFO, IMODE, ITYPE, J, JCOL, JSIZE, JTYPE, 00472 $ LOG2UI, M, MINWRK, MMAX, MNMAX, MNMIN, MQ, 00473 $ MTYPES, N, NFAIL, NMAX, NTEST 00474 DOUBLE PRECISION AMNINV, ANORM, COND, OVFL, RTOVFL, RTUNFL, 00475 $ TEMP1, TEMP2, ULP, ULPINV, UNFL 00476 * .. 00477 * .. Local Arrays .. 00478 INTEGER IDUM( 1 ), IOLDSD( 4 ), KMAGN( MAXTYP ), 00479 $ KMODE( MAXTYP ), KTYPE( MAXTYP ) 00480 DOUBLE PRECISION DUM( 1 ), DUMMA( 1 ), RESULT( 19 ) 00481 * .. 00482 * .. External Functions .. 00483 DOUBLE PRECISION DLAMCH, DLARND 00484 EXTERNAL DLAMCH, DLARND 00485 * .. 00486 * .. External Subroutines .. 00487 EXTERNAL ALASUM, DBDSDC, DBDSQR, DBDT01, DBDT02, DBDT03, 00488 $ DCOPY, DGEBRD, DGEMM, DLABAD, DLACPY, DLAHD2, 00489 $ DLASET, DLATMR, DLATMS, DORGBR, DORT01, XERBLA 00490 * .. 00491 * .. Intrinsic Functions .. 00492 INTRINSIC ABS, EXP, INT, LOG, MAX, MIN, SQRT 00493 * .. 00494 * .. Scalars in Common .. 00495 LOGICAL LERR, OK 00496 CHARACTER*32 SRNAMT 00497 INTEGER INFOT, NUNIT 00498 * .. 00499 * .. Common blocks .. 00500 COMMON / INFOC / INFOT, NUNIT, OK, LERR 00501 COMMON / SRNAMC / SRNAMT 00502 * .. 00503 * .. Data statements .. 00504 DATA KTYPE / 1, 2, 5*4, 5*6, 3*9, 10 / 00505 DATA KMAGN / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3, 0 / 00506 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, 00507 $ 0, 0, 0 / 00508 * .. 00509 * .. Executable Statements .. 00510 * 00511 * Check for errors 00512 * 00513 INFO = 0 00514 * 00515 BADMM = .FALSE. 00516 BADNN = .FALSE. 00517 MMAX = 1 00518 NMAX = 1 00519 MNMAX = 1 00520 MINWRK = 1 00521 DO 10 J = 1, NSIZES 00522 MMAX = MAX( MMAX, MVAL( J ) ) 00523 IF( MVAL( J ).LT.0 ) 00524 $ BADMM = .TRUE. 00525 NMAX = MAX( NMAX, NVAL( J ) ) 00526 IF( NVAL( J ).LT.0 ) 00527 $ BADNN = .TRUE. 00528 MNMAX = MAX( MNMAX, MIN( MVAL( J ), NVAL( J ) ) ) 00529 MINWRK = MAX( MINWRK, 3*( MVAL( J )+NVAL( J ) ), 00530 $ MVAL( J )*( MVAL( J )+MAX( MVAL( J ), NVAL( J ), 00531 $ NRHS )+1 )+NVAL( J )*MIN( NVAL( J ), MVAL( J ) ) ) 00532 10 CONTINUE 00533 * 00534 * Check for errors 00535 * 00536 IF( NSIZES.LT.0 ) THEN 00537 INFO = -1 00538 ELSE IF( BADMM ) THEN 00539 INFO = -2 00540 ELSE IF( BADNN ) THEN 00541 INFO = -3 00542 ELSE IF( NTYPES.LT.0 ) THEN 00543 INFO = -4 00544 ELSE IF( NRHS.LT.0 ) THEN 00545 INFO = -6 00546 ELSE IF( LDA.LT.MMAX ) THEN 00547 INFO = -11 00548 ELSE IF( LDX.LT.MMAX ) THEN 00549 INFO = -17 00550 ELSE IF( LDQ.LT.MMAX ) THEN 00551 INFO = -21 00552 ELSE IF( LDPT.LT.MNMAX ) THEN 00553 INFO = -23 00554 ELSE IF( MINWRK.GT.LWORK ) THEN 00555 INFO = -27 00556 END IF 00557 * 00558 IF( INFO.NE.0 ) THEN 00559 CALL XERBLA( 'DCHKBD', -INFO ) 00560 RETURN 00561 END IF 00562 * 00563 * Initialize constants 00564 * 00565 PATH( 1: 1 ) = 'Double precision' 00566 PATH( 2: 3 ) = 'BD' 00567 NFAIL = 0 00568 NTEST = 0 00569 UNFL = DLAMCH( 'Safe minimum' ) 00570 OVFL = DLAMCH( 'Overflow' ) 00571 CALL DLABAD( UNFL, OVFL ) 00572 ULP = DLAMCH( 'Precision' ) 00573 ULPINV = ONE / ULP 00574 LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) 00575 RTUNFL = SQRT( UNFL ) 00576 RTOVFL = SQRT( OVFL ) 00577 INFOT = 0 00578 * 00579 * Loop over sizes, types 00580 * 00581 DO 200 JSIZE = 1, NSIZES 00582 M = MVAL( JSIZE ) 00583 N = NVAL( JSIZE ) 00584 MNMIN = MIN( M, N ) 00585 AMNINV = ONE / MAX( M, N, 1 ) 00586 * 00587 IF( NSIZES.NE.1 ) THEN 00588 MTYPES = MIN( MAXTYP, NTYPES ) 00589 ELSE 00590 MTYPES = MIN( MAXTYP+1, NTYPES ) 00591 END IF 00592 * 00593 DO 190 JTYPE = 1, MTYPES 00594 IF( .NOT.DOTYPE( JTYPE ) ) 00595 $ GO TO 190 00596 * 00597 DO 20 J = 1, 4 00598 IOLDSD( J ) = ISEED( J ) 00599 20 CONTINUE 00600 * 00601 DO 30 J = 1, 14 00602 RESULT( J ) = -ONE 00603 30 CONTINUE 00604 * 00605 UPLO = ' ' 00606 * 00607 * Compute "A" 00608 * 00609 * Control parameters: 00610 * 00611 * KMAGN KMODE KTYPE 00612 * =1 O(1) clustered 1 zero 00613 * =2 large clustered 2 identity 00614 * =3 small exponential (none) 00615 * =4 arithmetic diagonal, (w/ eigenvalues) 00616 * =5 random symmetric, w/ eigenvalues 00617 * =6 nonsymmetric, w/ singular values 00618 * =7 random diagonal 00619 * =8 random symmetric 00620 * =9 random nonsymmetric 00621 * =10 random bidiagonal (log. distrib.) 00622 * 00623 IF( MTYPES.GT.MAXTYP ) 00624 $ GO TO 100 00625 * 00626 ITYPE = KTYPE( JTYPE ) 00627 IMODE = KMODE( JTYPE ) 00628 * 00629 * Compute norm 00630 * 00631 GO TO ( 40, 50, 60 )KMAGN( JTYPE ) 00632 * 00633 40 CONTINUE 00634 ANORM = ONE 00635 GO TO 70 00636 * 00637 50 CONTINUE 00638 ANORM = ( RTOVFL*ULP )*AMNINV 00639 GO TO 70 00640 * 00641 60 CONTINUE 00642 ANORM = RTUNFL*MAX( M, N )*ULPINV 00643 GO TO 70 00644 * 00645 70 CONTINUE 00646 * 00647 CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA ) 00648 IINFO = 0 00649 COND = ULPINV 00650 * 00651 BIDIAG = .FALSE. 00652 IF( ITYPE.EQ.1 ) THEN 00653 * 00654 * Zero matrix 00655 * 00656 IINFO = 0 00657 * 00658 ELSE IF( ITYPE.EQ.2 ) THEN 00659 * 00660 * Identity 00661 * 00662 DO 80 JCOL = 1, MNMIN 00663 A( JCOL, JCOL ) = ANORM 00664 80 CONTINUE 00665 * 00666 ELSE IF( ITYPE.EQ.4 ) THEN 00667 * 00668 * Diagonal Matrix, [Eigen]values Specified 00669 * 00670 CALL DLATMS( MNMIN, MNMIN, 'S', ISEED, 'N', WORK, IMODE, 00671 $ COND, ANORM, 0, 0, 'N', A, LDA, 00672 $ WORK( MNMIN+1 ), IINFO ) 00673 * 00674 ELSE IF( ITYPE.EQ.5 ) THEN 00675 * 00676 * Symmetric, eigenvalues specified 00677 * 00678 CALL DLATMS( MNMIN, MNMIN, 'S', ISEED, 'S', WORK, IMODE, 00679 $ COND, ANORM, M, N, 'N', A, LDA, 00680 $ WORK( MNMIN+1 ), IINFO ) 00681 * 00682 ELSE IF( ITYPE.EQ.6 ) THEN 00683 * 00684 * Nonsymmetric, singular values specified 00685 * 00686 CALL DLATMS( M, N, 'S', ISEED, 'N', WORK, IMODE, COND, 00687 $ ANORM, M, N, 'N', A, LDA, WORK( MNMIN+1 ), 00688 $ IINFO ) 00689 * 00690 ELSE IF( ITYPE.EQ.7 ) THEN 00691 * 00692 * Diagonal, random entries 00693 * 00694 CALL DLATMR( MNMIN, MNMIN, 'S', ISEED, 'N', WORK, 6, ONE, 00695 $ ONE, 'T', 'N', WORK( MNMIN+1 ), 1, ONE, 00696 $ WORK( 2*MNMIN+1 ), 1, ONE, 'N', IWORK, 0, 0, 00697 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00698 * 00699 ELSE IF( ITYPE.EQ.8 ) THEN 00700 * 00701 * Symmetric, random entries 00702 * 00703 CALL DLATMR( MNMIN, MNMIN, 'S', ISEED, 'S', WORK, 6, ONE, 00704 $ ONE, 'T', 'N', WORK( MNMIN+1 ), 1, ONE, 00705 $ WORK( M+MNMIN+1 ), 1, ONE, 'N', IWORK, M, N, 00706 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00707 * 00708 ELSE IF( ITYPE.EQ.9 ) THEN 00709 * 00710 * Nonsymmetric, random entries 00711 * 00712 CALL DLATMR( M, N, 'S', ISEED, 'N', WORK, 6, ONE, ONE, 00713 $ 'T', 'N', WORK( MNMIN+1 ), 1, ONE, 00714 $ WORK( M+MNMIN+1 ), 1, ONE, 'N', IWORK, M, N, 00715 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 00716 * 00717 ELSE IF( ITYPE.EQ.10 ) THEN 00718 * 00719 * Bidiagonal, random entries 00720 * 00721 TEMP1 = -TWO*LOG( ULP ) 00722 DO 90 J = 1, MNMIN 00723 BD( J ) = EXP( TEMP1*DLARND( 2, ISEED ) ) 00724 IF( J.LT.MNMIN ) 00725 $ BE( J ) = EXP( TEMP1*DLARND( 2, ISEED ) ) 00726 90 CONTINUE 00727 * 00728 IINFO = 0 00729 BIDIAG = .TRUE. 00730 IF( M.GE.N ) THEN 00731 UPLO = 'U' 00732 ELSE 00733 UPLO = 'L' 00734 END IF 00735 ELSE 00736 IINFO = 1 00737 END IF 00738 * 00739 IF( IINFO.EQ.0 ) THEN 00740 * 00741 * Generate Right-Hand Side 00742 * 00743 IF( BIDIAG ) THEN 00744 CALL DLATMR( MNMIN, NRHS, 'S', ISEED, 'N', WORK, 6, 00745 $ ONE, ONE, 'T', 'N', WORK( MNMIN+1 ), 1, 00746 $ ONE, WORK( 2*MNMIN+1 ), 1, ONE, 'N', 00747 $ IWORK, MNMIN, NRHS, ZERO, ONE, 'NO', Y, 00748 $ LDX, IWORK, IINFO ) 00749 ELSE 00750 CALL DLATMR( M, NRHS, 'S', ISEED, 'N', WORK, 6, ONE, 00751 $ ONE, 'T', 'N', WORK( M+1 ), 1, ONE, 00752 $ WORK( 2*M+1 ), 1, ONE, 'N', IWORK, M, 00753 $ NRHS, ZERO, ONE, 'NO', X, LDX, IWORK, 00754 $ IINFO ) 00755 END IF 00756 END IF 00757 * 00758 * Error Exit 00759 * 00760 IF( IINFO.NE.0 ) THEN 00761 WRITE( NOUT, FMT = 9998 )'Generator', IINFO, M, N, 00762 $ JTYPE, IOLDSD 00763 INFO = ABS( IINFO ) 00764 RETURN 00765 END IF 00766 * 00767 100 CONTINUE 00768 * 00769 * Call DGEBRD and DORGBR to compute B, Q, and P, do tests. 00770 * 00771 IF( .NOT.BIDIAG ) THEN 00772 * 00773 * Compute transformations to reduce A to bidiagonal form: 00774 * B := Q' * A * P. 00775 * 00776 CALL DLACPY( ' ', M, N, A, LDA, Q, LDQ ) 00777 CALL DGEBRD( M, N, Q, LDQ, BD, BE, WORK, WORK( MNMIN+1 ), 00778 $ WORK( 2*MNMIN+1 ), LWORK-2*MNMIN, IINFO ) 00779 * 00780 * Check error code from DGEBRD. 00781 * 00782 IF( IINFO.NE.0 ) THEN 00783 WRITE( NOUT, FMT = 9998 )'DGEBRD', IINFO, M, N, 00784 $ JTYPE, IOLDSD 00785 INFO = ABS( IINFO ) 00786 RETURN 00787 END IF 00788 * 00789 CALL DLACPY( ' ', M, N, Q, LDQ, PT, LDPT ) 00790 IF( M.GE.N ) THEN 00791 UPLO = 'U' 00792 ELSE 00793 UPLO = 'L' 00794 END IF 00795 * 00796 * Generate Q 00797 * 00798 MQ = M 00799 IF( NRHS.LE.0 ) 00800 $ MQ = MNMIN 00801 CALL DORGBR( 'Q', M, MQ, N, Q, LDQ, WORK, 00802 $ WORK( 2*MNMIN+1 ), LWORK-2*MNMIN, IINFO ) 00803 * 00804 * Check error code from DORGBR. 00805 * 00806 IF( IINFO.NE.0 ) THEN 00807 WRITE( NOUT, FMT = 9998 )'DORGBR(Q)', IINFO, M, N, 00808 $ JTYPE, IOLDSD 00809 INFO = ABS( IINFO ) 00810 RETURN 00811 END IF 00812 * 00813 * Generate P' 00814 * 00815 CALL DORGBR( 'P', MNMIN, N, M, PT, LDPT, WORK( MNMIN+1 ), 00816 $ WORK( 2*MNMIN+1 ), LWORK-2*MNMIN, IINFO ) 00817 * 00818 * Check error code from DORGBR. 00819 * 00820 IF( IINFO.NE.0 ) THEN 00821 WRITE( NOUT, FMT = 9998 )'DORGBR(P)', IINFO, M, N, 00822 $ JTYPE, IOLDSD 00823 INFO = ABS( IINFO ) 00824 RETURN 00825 END IF 00826 * 00827 * Apply Q' to an M by NRHS matrix X: Y := Q' * X. 00828 * 00829 CALL DGEMM( 'Transpose', 'No transpose', M, NRHS, M, ONE, 00830 $ Q, LDQ, X, LDX, ZERO, Y, LDX ) 00831 * 00832 * Test 1: Check the decomposition A := Q * B * PT 00833 * 2: Check the orthogonality of Q 00834 * 3: Check the orthogonality of PT 00835 * 00836 CALL DBDT01( M, N, 1, A, LDA, Q, LDQ, BD, BE, PT, LDPT, 00837 $ WORK, RESULT( 1 ) ) 00838 CALL DORT01( 'Columns', M, MQ, Q, LDQ, WORK, LWORK, 00839 $ RESULT( 2 ) ) 00840 CALL DORT01( 'Rows', MNMIN, N, PT, LDPT, WORK, LWORK, 00841 $ RESULT( 3 ) ) 00842 END IF 00843 * 00844 * Use DBDSQR to form the SVD of the bidiagonal matrix B: 00845 * B := U * S1 * VT, and compute Z = U' * Y. 00846 * 00847 CALL DCOPY( MNMIN, BD, 1, S1, 1 ) 00848 IF( MNMIN.GT.0 ) 00849 $ CALL DCOPY( MNMIN-1, BE, 1, WORK, 1 ) 00850 CALL DLACPY( ' ', M, NRHS, Y, LDX, Z, LDX ) 00851 CALL DLASET( 'Full', MNMIN, MNMIN, ZERO, ONE, U, LDPT ) 00852 CALL DLASET( 'Full', MNMIN, MNMIN, ZERO, ONE, VT, LDPT ) 00853 * 00854 CALL DBDSQR( UPLO, MNMIN, MNMIN, MNMIN, NRHS, S1, WORK, VT, 00855 $ LDPT, U, LDPT, Z, LDX, WORK( MNMIN+1 ), IINFO ) 00856 * 00857 * Check error code from DBDSQR. 00858 * 00859 IF( IINFO.NE.0 ) THEN 00860 WRITE( NOUT, FMT = 9998 )'DBDSQR(vects)', IINFO, M, N, 00861 $ JTYPE, IOLDSD 00862 INFO = ABS( IINFO ) 00863 IF( IINFO.LT.0 ) THEN 00864 RETURN 00865 ELSE 00866 RESULT( 4 ) = ULPINV 00867 GO TO 170 00868 END IF 00869 END IF 00870 * 00871 * Use DBDSQR to compute only the singular values of the 00872 * bidiagonal matrix B; U, VT, and Z should not be modified. 00873 * 00874 CALL DCOPY( MNMIN, BD, 1, S2, 1 ) 00875 IF( MNMIN.GT.0 ) 00876 $ CALL DCOPY( MNMIN-1, BE, 1, WORK, 1 ) 00877 * 00878 CALL DBDSQR( UPLO, MNMIN, 0, 0, 0, S2, WORK, VT, LDPT, U, 00879 $ LDPT, Z, LDX, WORK( MNMIN+1 ), IINFO ) 00880 * 00881 * Check error code from DBDSQR. 00882 * 00883 IF( IINFO.NE.0 ) THEN 00884 WRITE( NOUT, FMT = 9998 )'DBDSQR(values)', IINFO, M, N, 00885 $ JTYPE, IOLDSD 00886 INFO = ABS( IINFO ) 00887 IF( IINFO.LT.0 ) THEN 00888 RETURN 00889 ELSE 00890 RESULT( 9 ) = ULPINV 00891 GO TO 170 00892 END IF 00893 END IF 00894 * 00895 * Test 4: Check the decomposition B := U * S1 * VT 00896 * 5: Check the computation Z := U' * Y 00897 * 6: Check the orthogonality of U 00898 * 7: Check the orthogonality of VT 00899 * 00900 CALL DBDT03( UPLO, MNMIN, 1, BD, BE, U, LDPT, S1, VT, LDPT, 00901 $ WORK, RESULT( 4 ) ) 00902 CALL DBDT02( MNMIN, NRHS, Y, LDX, Z, LDX, U, LDPT, WORK, 00903 $ RESULT( 5 ) ) 00904 CALL DORT01( 'Columns', MNMIN, MNMIN, U, LDPT, WORK, LWORK, 00905 $ RESULT( 6 ) ) 00906 CALL DORT01( 'Rows', MNMIN, MNMIN, VT, LDPT, WORK, LWORK, 00907 $ RESULT( 7 ) ) 00908 * 00909 * Test 8: Check that the singular values are sorted in 00910 * non-increasing order and are non-negative 00911 * 00912 RESULT( 8 ) = ZERO 00913 DO 110 I = 1, MNMIN - 1 00914 IF( S1( I ).LT.S1( I+1 ) ) 00915 $ RESULT( 8 ) = ULPINV 00916 IF( S1( I ).LT.ZERO ) 00917 $ RESULT( 8 ) = ULPINV 00918 110 CONTINUE 00919 IF( MNMIN.GE.1 ) THEN 00920 IF( S1( MNMIN ).LT.ZERO ) 00921 $ RESULT( 8 ) = ULPINV 00922 END IF 00923 * 00924 * Test 9: Compare DBDSQR with and without singular vectors 00925 * 00926 TEMP2 = ZERO 00927 * 00928 DO 120 J = 1, MNMIN 00929 TEMP1 = ABS( S1( J )-S2( J ) ) / 00930 $ MAX( SQRT( UNFL )*MAX( S1( 1 ), ONE ), 00931 $ ULP*MAX( ABS( S1( J ) ), ABS( S2( J ) ) ) ) 00932 TEMP2 = MAX( TEMP1, TEMP2 ) 00933 120 CONTINUE 00934 * 00935 RESULT( 9 ) = TEMP2 00936 * 00937 * Test 10: Sturm sequence test of singular values 00938 * Go up by factors of two until it succeeds 00939 * 00940 TEMP1 = THRESH*( HALF-ULP ) 00941 * 00942 DO 130 J = 0, LOG2UI 00943 * CALL DSVDCH( MNMIN, BD, BE, S1, TEMP1, IINFO ) 00944 IF( IINFO.EQ.0 ) 00945 $ GO TO 140 00946 TEMP1 = TEMP1*TWO 00947 130 CONTINUE 00948 * 00949 140 CONTINUE 00950 RESULT( 10 ) = TEMP1 00951 * 00952 * Use DBDSQR to form the decomposition A := (QU) S (VT PT) 00953 * from the bidiagonal form A := Q B PT. 00954 * 00955 IF( .NOT.BIDIAG ) THEN 00956 CALL DCOPY( MNMIN, BD, 1, S2, 1 ) 00957 IF( MNMIN.GT.0 ) 00958 $ CALL DCOPY( MNMIN-1, BE, 1, WORK, 1 ) 00959 * 00960 CALL DBDSQR( UPLO, MNMIN, N, M, NRHS, S2, WORK, PT, LDPT, 00961 $ Q, LDQ, Y, LDX, WORK( MNMIN+1 ), IINFO ) 00962 * 00963 * Test 11: Check the decomposition A := Q*U * S2 * VT*PT 00964 * 12: Check the computation Z := U' * Q' * X 00965 * 13: Check the orthogonality of Q*U 00966 * 14: Check the orthogonality of VT*PT 00967 * 00968 CALL DBDT01( M, N, 0, A, LDA, Q, LDQ, S2, DUMMA, PT, 00969 $ LDPT, WORK, RESULT( 11 ) ) 00970 CALL DBDT02( M, NRHS, X, LDX, Y, LDX, Q, LDQ, WORK, 00971 $ RESULT( 12 ) ) 00972 CALL DORT01( 'Columns', M, MQ, Q, LDQ, WORK, LWORK, 00973 $ RESULT( 13 ) ) 00974 CALL DORT01( 'Rows', MNMIN, N, PT, LDPT, WORK, LWORK, 00975 $ RESULT( 14 ) ) 00976 END IF 00977 * 00978 * Use DBDSDC to form the SVD of the bidiagonal matrix B: 00979 * B := U * S1 * VT 00980 * 00981 CALL DCOPY( MNMIN, BD, 1, S1, 1 ) 00982 IF( MNMIN.GT.0 ) 00983 $ CALL DCOPY( MNMIN-1, BE, 1, WORK, 1 ) 00984 CALL DLASET( 'Full', MNMIN, MNMIN, ZERO, ONE, U, LDPT ) 00985 CALL DLASET( 'Full', MNMIN, MNMIN, ZERO, ONE, VT, LDPT ) 00986 * 00987 CALL DBDSDC( UPLO, 'I', MNMIN, S1, WORK, U, LDPT, VT, LDPT, 00988 $ DUM, IDUM, WORK( MNMIN+1 ), IWORK, IINFO ) 00989 * 00990 * Check error code from DBDSDC. 00991 * 00992 IF( IINFO.NE.0 ) THEN 00993 WRITE( NOUT, FMT = 9998 )'DBDSDC(vects)', IINFO, M, N, 00994 $ JTYPE, IOLDSD 00995 INFO = ABS( IINFO ) 00996 IF( IINFO.LT.0 ) THEN 00997 RETURN 00998 ELSE 00999 RESULT( 15 ) = ULPINV 01000 GO TO 170 01001 END IF 01002 END IF 01003 * 01004 * Use DBDSDC to compute only the singular values of the 01005 * bidiagonal matrix B; U and VT should not be modified. 01006 * 01007 CALL DCOPY( MNMIN, BD, 1, S2, 1 ) 01008 IF( MNMIN.GT.0 ) 01009 $ CALL DCOPY( MNMIN-1, BE, 1, WORK, 1 ) 01010 * 01011 CALL DBDSDC( UPLO, 'N', MNMIN, S2, WORK, DUM, 1, DUM, 1, 01012 $ DUM, IDUM, WORK( MNMIN+1 ), IWORK, IINFO ) 01013 * 01014 * Check error code from DBDSDC. 01015 * 01016 IF( IINFO.NE.0 ) THEN 01017 WRITE( NOUT, FMT = 9998 )'DBDSDC(values)', IINFO, M, N, 01018 $ JTYPE, IOLDSD 01019 INFO = ABS( IINFO ) 01020 IF( IINFO.LT.0 ) THEN 01021 RETURN 01022 ELSE 01023 RESULT( 18 ) = ULPINV 01024 GO TO 170 01025 END IF 01026 END IF 01027 * 01028 * Test 15: Check the decomposition B := U * S1 * VT 01029 * 16: Check the orthogonality of U 01030 * 17: Check the orthogonality of VT 01031 * 01032 CALL DBDT03( UPLO, MNMIN, 1, BD, BE, U, LDPT, S1, VT, LDPT, 01033 $ WORK, RESULT( 15 ) ) 01034 CALL DORT01( 'Columns', MNMIN, MNMIN, U, LDPT, WORK, LWORK, 01035 $ RESULT( 16 ) ) 01036 CALL DORT01( 'Rows', MNMIN, MNMIN, VT, LDPT, WORK, LWORK, 01037 $ RESULT( 17 ) ) 01038 * 01039 * Test 18: Check that the singular values are sorted in 01040 * non-increasing order and are non-negative 01041 * 01042 RESULT( 18 ) = ZERO 01043 DO 150 I = 1, MNMIN - 1 01044 IF( S1( I ).LT.S1( I+1 ) ) 01045 $ RESULT( 18 ) = ULPINV 01046 IF( S1( I ).LT.ZERO ) 01047 $ RESULT( 18 ) = ULPINV 01048 150 CONTINUE 01049 IF( MNMIN.GE.1 ) THEN 01050 IF( S1( MNMIN ).LT.ZERO ) 01051 $ RESULT( 18 ) = ULPINV 01052 END IF 01053 * 01054 * Test 19: Compare DBDSQR with and without singular vectors 01055 * 01056 TEMP2 = ZERO 01057 * 01058 DO 160 J = 1, MNMIN 01059 TEMP1 = ABS( S1( J )-S2( J ) ) / 01060 $ MAX( SQRT( UNFL )*MAX( S1( 1 ), ONE ), 01061 $ ULP*MAX( ABS( S1( 1 ) ), ABS( S2( 1 ) ) ) ) 01062 TEMP2 = MAX( TEMP1, TEMP2 ) 01063 160 CONTINUE 01064 * 01065 RESULT( 19 ) = TEMP2 01066 * 01067 * End of Loop -- Check for RESULT(j) > THRESH 01068 * 01069 170 CONTINUE 01070 DO 180 J = 1, 19 01071 IF( RESULT( J ).GE.THRESH ) THEN 01072 IF( NFAIL.EQ.0 ) 01073 $ CALL DLAHD2( NOUT, PATH ) 01074 WRITE( NOUT, FMT = 9999 )M, N, JTYPE, IOLDSD, J, 01075 $ RESULT( J ) 01076 NFAIL = NFAIL + 1 01077 END IF 01078 180 CONTINUE 01079 IF( .NOT.BIDIAG ) THEN 01080 NTEST = NTEST + 19 01081 ELSE 01082 NTEST = NTEST + 5 01083 END IF 01084 * 01085 190 CONTINUE 01086 200 CONTINUE 01087 * 01088 * Summary 01089 * 01090 CALL ALASUM( PATH, NOUT, NFAIL, NTEST, 0 ) 01091 * 01092 RETURN 01093 * 01094 * End of DCHKBD 01095 * 01096 9999 FORMAT( ' M=', I5, ', N=', I5, ', type ', I2, ', seed=', 01097 $ 4( I4, ',' ), ' test(', I2, ')=', G11.4 ) 01098 9998 FORMAT( ' DCHKBD: ', A, ' returned INFO=', I6, '.', / 9X, 'M=', 01099 $ I6, ', N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), 01100 $ I5, ')' ) 01101 * 01102 END