LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
schkbd.f
Go to the documentation of this file.
00001 *> \brief \b SCHKBD
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 SCHKBD( 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 *       REAL               THRESH
00020 *       ..
00021 *       .. Array Arguments ..
00022 *       LOGICAL            DOTYPE( * )
00023 *       INTEGER            ISEED( 4 ), IWORK( * ), MVAL( * ), NVAL( * )
00024 *       REAL               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 *> SCHKBD checks the singular value decomposition (SVD) routines.
00037 *>
00038 *> SGEBRD 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 *> SORGBR generates the orthogonal matrices Q and P' from SGEBRD.
00044 *> Note that Q and P are not necessarily square.
00045 *>
00046 *> SBDSQR 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, SBDSQR has an option to apply the left orthogonal matrix
00055 *> U to a matrix X, useful in least squares applications.
00056 *>
00057 *> SBDSDC 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 SGEBRD and SORGBR
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 SBDSQR 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 *>       SSVDCH)
00106 *>
00107 *> Test SBDSQR 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 SBDSDC 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) SGEBRD 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, SCHKBD
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 SBDSQR.  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 SCHKBD to continue the same random
00240 *>          number sequence.
00241 *> \endverbatim
00242 *>
00243 *> \param[in] THRESH
00244 *> \verbatim
00245 *>          THRESH is REAL
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 REAL 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 REAL array, dimension
00269 *>                      (max(min(MVAL(j),NVAL(j))))
00270 *> \endverbatim
00271 *>
00272 *> \param[out] BE
00273 *> \verbatim
00274 *>          BE is REAL array, dimension
00275 *>                      (max(min(MVAL(j),NVAL(j))))
00276 *> \endverbatim
00277 *>
00278 *> \param[out] S1
00279 *> \verbatim
00280 *>          S1 is REAL array, dimension
00281 *>                      (max(min(MVAL(j),NVAL(j))))
00282 *> \endverbatim
00283 *>
00284 *> \param[out] S2
00285 *> \verbatim
00286 *>          S2 is REAL array, dimension
00287 *>                      (max(min(MVAL(j),NVAL(j))))
00288 *> \endverbatim
00289 *>
00290 *> \param[out] X
00291 *> \verbatim
00292 *>          X is REAL 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 REAL array, dimension (LDX,NRHS)
00305 *> \endverbatim
00306 *>
00307 *> \param[out] Z
00308 *> \verbatim
00309 *>          Z is REAL array, dimension (LDX,NRHS)
00310 *> \endverbatim
00311 *>
00312 *> \param[out] Q
00313 *> \verbatim
00314 *>          Q is REAL 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 REAL 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 REAL array, dimension
00338 *>                      (LDPT,max(min(MVAL(j),NVAL(j))))
00339 *> \endverbatim
00340 *>
00341 *> \param[out] VT
00342 *> \verbatim
00343 *>          VT is REAL array, dimension
00344 *>                      (LDPT,max(min(MVAL(j),NVAL(j))))
00345 *> \endverbatim
00346 *>
00347 *> \param[out] WORK
00348 *> \verbatim
00349 *>          WORK is REAL 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  SLATMR, SLATMS, SGEBRD, SORGBR, or SBDSQR,
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 single_eig
00432 *
00433 *  =====================================================================
00434       SUBROUTINE SCHKBD( 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       REAL               THRESH
00448 *     ..
00449 *     .. Array Arguments ..
00450       LOGICAL            DOTYPE( * )
00451       INTEGER            ISEED( 4 ), IWORK( * ), MVAL( * ), NVAL( * )
00452       REAL               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       REAL               ZERO, ONE, TWO, HALF
00462       PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
00463      $                   HALF = 0.5E0 )
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       REAL               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       REAL               DUM( 1 ), DUMMA( 1 ), RESULT( 19 )
00481 *     ..
00482 *     .. External Functions ..
00483       REAL               SLAMCH, SLARND
00484       EXTERNAL           SLAMCH, SLARND
00485 *     ..
00486 *     .. External Subroutines ..
00487       EXTERNAL           ALASUM, SBDSDC, SBDSQR, SBDT01, SBDT02, SBDT03,
00488      $                   SCOPY, SGEBRD, SGEMM, SLABAD, SLACPY, SLAHD2,
00489      $                   SLASET, SLATMR, SLATMS, SORGBR, SORT01, 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( 'SCHKBD', -INFO )
00560          RETURN
00561       END IF
00562 *
00563 *     Initialize constants
00564 *
00565       PATH( 1: 1 ) = 'Single precision'
00566       PATH( 2: 3 ) = 'BD'
00567       NFAIL = 0
00568       NTEST = 0
00569       UNFL = SLAMCH( 'Safe minimum' )
00570       OVFL = SLAMCH( 'Overflow' )
00571       CALL SLABAD( UNFL, OVFL )
00572       ULP = SLAMCH( '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 SLASET( '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 SLATMS( 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 SLATMS( 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 SLATMS( 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 SLATMR( 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 SLATMR( 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 SLATMR( 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*SLARND( 2, ISEED ) )
00724                   IF( J.LT.MNMIN )
00725      $               BE( J ) = EXP( TEMP1*SLARND( 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 SLATMR( 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 SLATMR( 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 SGEBRD and SORGBR 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 SLACPY( ' ', M, N, A, LDA, Q, LDQ )
00777                CALL SGEBRD( 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 SGEBRD.
00781 *
00782                IF( IINFO.NE.0 ) THEN
00783                   WRITE( NOUT, FMT = 9998 )'SGEBRD', IINFO, M, N,
00784      $               JTYPE, IOLDSD
00785                   INFO = ABS( IINFO )
00786                   RETURN
00787                END IF
00788 *
00789                CALL SLACPY( ' ', 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 SORGBR( 'Q', M, MQ, N, Q, LDQ, WORK,
00802      $                      WORK( 2*MNMIN+1 ), LWORK-2*MNMIN, IINFO )
00803 *
00804 *              Check error code from SORGBR.
00805 *
00806                IF( IINFO.NE.0 ) THEN
00807                   WRITE( NOUT, FMT = 9998 )'SORGBR(Q)', IINFO, M, N,
00808      $               JTYPE, IOLDSD
00809                   INFO = ABS( IINFO )
00810                   RETURN
00811                END IF
00812 *
00813 *              Generate P'
00814 *
00815                CALL SORGBR( 'P', MNMIN, N, M, PT, LDPT, WORK( MNMIN+1 ),
00816      $                      WORK( 2*MNMIN+1 ), LWORK-2*MNMIN, IINFO )
00817 *
00818 *              Check error code from SORGBR.
00819 *
00820                IF( IINFO.NE.0 ) THEN
00821                   WRITE( NOUT, FMT = 9998 )'SORGBR(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 SGEMM( '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 SBDT01( M, N, 1, A, LDA, Q, LDQ, BD, BE, PT, LDPT,
00837      $                      WORK, RESULT( 1 ) )
00838                CALL SORT01( 'Columns', M, MQ, Q, LDQ, WORK, LWORK,
00839      $                      RESULT( 2 ) )
00840                CALL SORT01( 'Rows', MNMIN, N, PT, LDPT, WORK, LWORK,
00841      $                      RESULT( 3 ) )
00842             END IF
00843 *
00844 *           Use SBDSQR to form the SVD of the bidiagonal matrix B:
00845 *           B := U * S1 * VT, and compute Z = U' * Y.
00846 *
00847             CALL SCOPY( MNMIN, BD, 1, S1, 1 )
00848             IF( MNMIN.GT.0 )
00849      $         CALL SCOPY( MNMIN-1, BE, 1, WORK, 1 )
00850             CALL SLACPY( ' ', M, NRHS, Y, LDX, Z, LDX )
00851             CALL SLASET( 'Full', MNMIN, MNMIN, ZERO, ONE, U, LDPT )
00852             CALL SLASET( 'Full', MNMIN, MNMIN, ZERO, ONE, VT, LDPT )
00853 *
00854             CALL SBDSQR( UPLO, MNMIN, MNMIN, MNMIN, NRHS, S1, WORK, VT,
00855      $                   LDPT, U, LDPT, Z, LDX, WORK( MNMIN+1 ), IINFO )
00856 *
00857 *           Check error code from SBDSQR.
00858 *
00859             IF( IINFO.NE.0 ) THEN
00860                WRITE( NOUT, FMT = 9998 )'SBDSQR(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 SBDSQR to compute only the singular values of the
00872 *           bidiagonal matrix B;  U, VT, and Z should not be modified.
00873 *
00874             CALL SCOPY( MNMIN, BD, 1, S2, 1 )
00875             IF( MNMIN.GT.0 )
00876      $         CALL SCOPY( MNMIN-1, BE, 1, WORK, 1 )
00877 *
00878             CALL SBDSQR( UPLO, MNMIN, 0, 0, 0, S2, WORK, VT, LDPT, U,
00879      $                   LDPT, Z, LDX, WORK( MNMIN+1 ), IINFO )
00880 *
00881 *           Check error code from SBDSQR.
00882 *
00883             IF( IINFO.NE.0 ) THEN
00884                WRITE( NOUT, FMT = 9998 )'SBDSQR(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 SBDT03( UPLO, MNMIN, 1, BD, BE, U, LDPT, S1, VT, LDPT,
00901      $                   WORK, RESULT( 4 ) )
00902             CALL SBDT02( MNMIN, NRHS, Y, LDX, Z, LDX, U, LDPT, WORK,
00903      $                   RESULT( 5 ) )
00904             CALL SORT01( 'Columns', MNMIN, MNMIN, U, LDPT, WORK, LWORK,
00905      $                   RESULT( 6 ) )
00906             CALL SORT01( '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 SBDSQR 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 SSVDCH( 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 SBDSQR 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 SCOPY( MNMIN, BD, 1, S2, 1 )
00957                IF( MNMIN.GT.0 )
00958      $            CALL SCOPY( MNMIN-1, BE, 1, WORK, 1 )
00959 *
00960                CALL SBDSQR( 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 SBDT01( M, N, 0, A, LDA, Q, LDQ, S2, DUMMA, PT,
00969      $                      LDPT, WORK, RESULT( 11 ) )
00970                CALL SBDT02( M, NRHS, X, LDX, Y, LDX, Q, LDQ, WORK,
00971      $                      RESULT( 12 ) )
00972                CALL SORT01( 'Columns', M, MQ, Q, LDQ, WORK, LWORK,
00973      $                      RESULT( 13 ) )
00974                CALL SORT01( 'Rows', MNMIN, N, PT, LDPT, WORK, LWORK,
00975      $                      RESULT( 14 ) )
00976             END IF
00977 *
00978 *           Use SBDSDC to form the SVD of the bidiagonal matrix B:
00979 *           B := U * S1 * VT
00980 *
00981             CALL SCOPY( MNMIN, BD, 1, S1, 1 )
00982             IF( MNMIN.GT.0 )
00983      $         CALL SCOPY( MNMIN-1, BE, 1, WORK, 1 )
00984             CALL SLASET( 'Full', MNMIN, MNMIN, ZERO, ONE, U, LDPT )
00985             CALL SLASET( 'Full', MNMIN, MNMIN, ZERO, ONE, VT, LDPT )
00986 *
00987             CALL SBDSDC( UPLO, 'I', MNMIN, S1, WORK, U, LDPT, VT, LDPT,
00988      $                   DUM, IDUM, WORK( MNMIN+1 ), IWORK, IINFO )
00989 *
00990 *           Check error code from SBDSDC.
00991 *
00992             IF( IINFO.NE.0 ) THEN
00993                WRITE( NOUT, FMT = 9998 )'SBDSDC(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 SBDSDC to compute only the singular values of the
01005 *           bidiagonal matrix B;  U and VT should not be modified.
01006 *
01007             CALL SCOPY( MNMIN, BD, 1, S2, 1 )
01008             IF( MNMIN.GT.0 )
01009      $         CALL SCOPY( MNMIN-1, BE, 1, WORK, 1 )
01010 *
01011             CALL SBDSDC( UPLO, 'N', MNMIN, S2, WORK, DUM, 1, DUM, 1,
01012      $                   DUM, IDUM, WORK( MNMIN+1 ), IWORK, IINFO )
01013 *
01014 *           Check error code from SBDSDC.
01015 *
01016             IF( IINFO.NE.0 ) THEN
01017                WRITE( NOUT, FMT = 9998 )'SBDSDC(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 SBDT03( UPLO, MNMIN, 1, BD, BE, U, LDPT, S1, VT, LDPT,
01033      $                   WORK, RESULT( 15 ) )
01034             CALL SORT01( 'Columns', MNMIN, MNMIN, U, LDPT, WORK, LWORK,
01035      $                   RESULT( 16 ) )
01036             CALL SORT01( '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 SBDSQR 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 SLAHD2( 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 SCHKBD
01095 *
01096  9999 FORMAT( ' M=', I5, ', N=', I5, ', type ', I2, ', seed=',
01097      $      4( I4, ',' ), ' test(', I2, ')=', G11.4 )
01098  9998 FORMAT( ' SCHKBD: ', A, ' returned INFO=', I6, '.', / 9X, 'M=',
01099      $      I6, ', N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ),
01100      $      I5, ')' )
01101 *
01102       END
 All Files Functions