LAPACK  3.9.0
LAPACK: Linear Algebra PACKage
ddrvbd.f
Go to the documentation of this file.
1 *> \brief \b DDRVBD
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE DDRVBD( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
12 * A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S,
13 * SSAV, E, WORK, LWORK, IWORK, NOUT, INFO )
14 *
15 * .. Scalar Arguments ..
16 * INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES,
17 * $ NTYPES
18 * DOUBLE PRECISION THRESH
19 * ..
20 * .. Array Arguments ..
21 * LOGICAL DOTYPE( * )
22 * INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
23 * DOUBLE PRECISION A( LDA, * ), ASAV( LDA, * ), E( * ), S( * ),
24 * $ SSAV( * ), U( LDU, * ), USAV( LDU, * ),
25 * $ VT( LDVT, * ), VTSAV( LDVT, * ), WORK( * )
26 * ..
27 *
28 *
29 *> \par Purpose:
30 * =============
31 *>
32 *> \verbatim
33 *>
34 *> DDRVBD checks the singular value decomposition (SVD) drivers
35 *> DGESVD, DGESDD, DGESVDQ, DGESVJ, DGEJSV, and DGESVDX.
36 *>
37 *> Both DGESVD and DGESDD factor A = U diag(S) VT, where U and VT are
38 *> orthogonal and diag(S) is diagonal with the entries of the array S
39 *> on its diagonal. The entries of S are the singular values,
40 *> nonnegative and stored in decreasing order. U and VT can be
41 *> optionally not computed, overwritten on A, or computed partially.
42 *>
43 *> A is M by N. Let MNMIN = min( M, N ). S has dimension MNMIN.
44 *> U can be M by M or M by MNMIN. VT can be N by N or MNMIN by N.
45 *>
46 *> When DDRVBD is called, a number of matrix "sizes" (M's and N's)
47 *> and a number of matrix "types" are specified. For each size (M,N)
48 *> and each type of matrix, and for the minimal workspace as well as
49 *> workspace adequate to permit blocking, an M x N matrix "A" will be
50 *> generated and used to test the SVD routines. For each matrix, A will
51 *> be factored as A = U diag(S) VT and the following 12 tests computed:
52 *>
53 *> Test for DGESVD:
54 *>
55 *> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
56 *>
57 *> (2) | I - U'U | / ( M ulp )
58 *>
59 *> (3) | I - VT VT' | / ( N ulp )
60 *>
61 *> (4) S contains MNMIN nonnegative values in decreasing order.
62 *> (Return 0 if true, 1/ULP if false.)
63 *>
64 *> (5) | U - Upartial | / ( M ulp ) where Upartial is a partially
65 *> computed U.
66 *>
67 *> (6) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
68 *> computed VT.
69 *>
70 *> (7) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
71 *> vector of singular values from the partial SVD
72 *>
73 *> Test for DGESDD:
74 *>
75 *> (8) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
76 *>
77 *> (9) | I - U'U | / ( M ulp )
78 *>
79 *> (10) | I - VT VT' | / ( N ulp )
80 *>
81 *> (11) S contains MNMIN nonnegative values in decreasing order.
82 *> (Return 0 if true, 1/ULP if false.)
83 *>
84 *> (12) | U - Upartial | / ( M ulp ) where Upartial is a partially
85 *> computed U.
86 *>
87 *> (13) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
88 *> computed VT.
89 *>
90 *> (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
91 *> vector of singular values from the partial SVD
92 *>
93 *> Test for DGESVDQ:
94 *>
95 *> (36) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
96 *>
97 *> (37) | I - U'U | / ( M ulp )
98 *>
99 *> (38) | I - VT VT' | / ( N ulp )
100 *>
101 *> (39) S contains MNMIN nonnegative values in decreasing order.
102 *> (Return 0 if true, 1/ULP if false.)
103 *>
104 *> Test for DGESVJ:
105 *>
106 *> (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
107 *>
108 *> (16) | I - U'U | / ( M ulp )
109 *>
110 *> (17) | I - VT VT' | / ( N ulp )
111 *>
112 *> (18) S contains MNMIN nonnegative values in decreasing order.
113 *> (Return 0 if true, 1/ULP if false.)
114 *>
115 *> Test for DGEJSV:
116 *>
117 *> (19) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
118 *>
119 *> (20) | I - U'U | / ( M ulp )
120 *>
121 *> (21) | I - VT VT' | / ( N ulp )
122 *>
123 *> (22) S contains MNMIN nonnegative values in decreasing order.
124 *> (Return 0 if true, 1/ULP if false.)
125 *>
126 *> Test for DGESVDX( 'V', 'V', 'A' )/DGESVDX( 'N', 'N', 'A' )
127 *>
128 *> (23) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
129 *>
130 *> (24) | I - U'U | / ( M ulp )
131 *>
132 *> (25) | I - VT VT' | / ( N ulp )
133 *>
134 *> (26) S contains MNMIN nonnegative values in decreasing order.
135 *> (Return 0 if true, 1/ULP if false.)
136 *>
137 *> (27) | U - Upartial | / ( M ulp ) where Upartial is a partially
138 *> computed U.
139 *>
140 *> (28) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
141 *> computed VT.
142 *>
143 *> (29) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
144 *> vector of singular values from the partial SVD
145 *>
146 *> Test for DGESVDX( 'V', 'V', 'I' )
147 *>
148 *> (30) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp )
149 *>
150 *> (31) | I - U'U | / ( M ulp )
151 *>
152 *> (32) | I - VT VT' | / ( N ulp )
153 *>
154 *> Test for DGESVDX( 'V', 'V', 'V' )
155 *>
156 *> (33) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp )
157 *>
158 *> (34) | I - U'U | / ( M ulp )
159 *>
160 *> (35) | I - VT VT' | / ( N ulp )
161 *>
162 *> The "sizes" are specified by the arrays MM(1:NSIZES) and
163 *> NN(1:NSIZES); the value of each element pair (MM(j),NN(j))
164 *> specifies one size. The "types" are specified by a logical array
165 *> DOTYPE( 1:NTYPES ); if DOTYPE(j) is .TRUE., then matrix type "j"
166 *> will be generated.
167 *> Currently, the list of possible types is:
168 *>
169 *> (1) The zero matrix.
170 *> (2) The identity matrix.
171 *> (3) A matrix of the form U D V, where U and V are orthogonal and
172 *> D has evenly spaced entries 1, ..., ULP with random signs
173 *> on the diagonal.
174 *> (4) Same as (3), but multiplied by the underflow-threshold / ULP.
175 *> (5) Same as (3), but multiplied by the overflow-threshold * ULP.
176 *> \endverbatim
177 *
178 * Arguments:
179 * ==========
180 *
181 *> \param[in] NSIZES
182 *> \verbatim
183 *> NSIZES is INTEGER
184 *> The number of matrix sizes (M,N) contained in the vectors
185 *> MM and NN.
186 *> \endverbatim
187 *>
188 *> \param[in] MM
189 *> \verbatim
190 *> MM is INTEGER array, dimension (NSIZES)
191 *> The values of the matrix row dimension M.
192 *> \endverbatim
193 *>
194 *> \param[in] NN
195 *> \verbatim
196 *> NN is INTEGER array, dimension (NSIZES)
197 *> The values of the matrix column dimension N.
198 *> \endverbatim
199 *>
200 *> \param[in] NTYPES
201 *> \verbatim
202 *> NTYPES is INTEGER
203 *> The number of elements in DOTYPE. If it is zero, DDRVBD
204 *> does nothing. It must be at least zero. If it is MAXTYP+1
205 *> and NSIZES is 1, then an additional type, MAXTYP+1 is
206 *> defined, which is to use whatever matrices are in A and B.
207 *> This is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
208 *> DOTYPE(MAXTYP+1) is .TRUE. .
209 *> \endverbatim
210 *>
211 *> \param[in] DOTYPE
212 *> \verbatim
213 *> DOTYPE is LOGICAL array, dimension (NTYPES)
214 *> If DOTYPE(j) is .TRUE., then for each size (m,n), a matrix
215 *> of type j will be generated. If NTYPES is smaller than the
216 *> maximum number of types defined (PARAMETER MAXTYP), then
217 *> types NTYPES+1 through MAXTYP will not be generated. If
218 *> NTYPES is larger than MAXTYP, DOTYPE(MAXTYP+1) through
219 *> DOTYPE(NTYPES) will be ignored.
220 *> \endverbatim
221 *>
222 *> \param[in,out] ISEED
223 *> \verbatim
224 *> ISEED is INTEGER array, dimension (4)
225 *> On entry, the seed of the random number generator. The array
226 *> elements should be between 0 and 4095; if not they will be
227 *> reduced mod 4096. Also, ISEED(4) must be odd.
228 *> On exit, ISEED is changed and can be used in the next call to
229 *> DDRVBD to continue the same random number sequence.
230 *> \endverbatim
231 *>
232 *> \param[in] THRESH
233 *> \verbatim
234 *> THRESH is DOUBLE PRECISION
235 *> The threshold value for the test ratios. A result is
236 *> included in the output file if RESULT >= THRESH. The test
237 *> ratios are scaled to be O(1), so THRESH should be a small
238 *> multiple of 1, e.g., 10 or 100. To have every test ratio
239 *> printed, use THRESH = 0.
240 *> \endverbatim
241 *>
242 *> \param[out] A
243 *> \verbatim
244 *> A is DOUBLE PRECISION array, dimension (LDA,NMAX)
245 *> where NMAX is the maximum value of N in NN.
246 *> \endverbatim
247 *>
248 *> \param[in] LDA
249 *> \verbatim
250 *> LDA is INTEGER
251 *> The leading dimension of the array A. LDA >= max(1,MMAX),
252 *> where MMAX is the maximum value of M in MM.
253 *> \endverbatim
254 *>
255 *> \param[out] U
256 *> \verbatim
257 *> U is DOUBLE PRECISION array, dimension (LDU,MMAX)
258 *> \endverbatim
259 *>
260 *> \param[in] LDU
261 *> \verbatim
262 *> LDU is INTEGER
263 *> The leading dimension of the array U. LDU >= max(1,MMAX).
264 *> \endverbatim
265 *>
266 *> \param[out] VT
267 *> \verbatim
268 *> VT is DOUBLE PRECISION array, dimension (LDVT,NMAX)
269 *> \endverbatim
270 *>
271 *> \param[in] LDVT
272 *> \verbatim
273 *> LDVT is INTEGER
274 *> The leading dimension of the array VT. LDVT >= max(1,NMAX).
275 *> \endverbatim
276 *>
277 *> \param[out] ASAV
278 *> \verbatim
279 *> ASAV is DOUBLE PRECISION array, dimension (LDA,NMAX)
280 *> \endverbatim
281 *>
282 *> \param[out] USAV
283 *> \verbatim
284 *> USAV is DOUBLE PRECISION array, dimension (LDU,MMAX)
285 *> \endverbatim
286 *>
287 *> \param[out] VTSAV
288 *> \verbatim
289 *> VTSAV is DOUBLE PRECISION array, dimension (LDVT,NMAX)
290 *> \endverbatim
291 *>
292 *> \param[out] S
293 *> \verbatim
294 *> S is DOUBLE PRECISION array, dimension
295 *> (max(min(MM,NN)))
296 *> \endverbatim
297 *>
298 *> \param[out] SSAV
299 *> \verbatim
300 *> SSAV is DOUBLE PRECISION array, dimension
301 *> (max(min(MM,NN)))
302 *> \endverbatim
303 *>
304 *> \param[out] E
305 *> \verbatim
306 *> E is DOUBLE PRECISION array, dimension
307 *> (max(min(MM,NN)))
308 *> \endverbatim
309 *>
310 *> \param[out] WORK
311 *> \verbatim
312 *> WORK is DOUBLE PRECISION array, dimension (LWORK)
313 *> \endverbatim
314 *>
315 *> \param[in] LWORK
316 *> \verbatim
317 *> LWORK is INTEGER
318 *> The number of entries in WORK. This must be at least
319 *> max(3*MN+MX,5*MN-4)+2*MN**2 for all pairs
320 *> pairs (MN,MX)=( min(MM(j),NN(j), max(MM(j),NN(j)) )
321 *> \endverbatim
322 *>
323 *> \param[out] IWORK
324 *> \verbatim
325 *> IWORK is INTEGER array, dimension at least 8*min(M,N)
326 *> \endverbatim
327 *>
328 *> \param[in] NOUT
329 *> \verbatim
330 *> NOUT is INTEGER
331 *> The FORTRAN unit number for printing out error messages
332 *> (e.g., if a routine returns IINFO not equal to 0.)
333 *> \endverbatim
334 *>
335 *> \param[out] INFO
336 *> \verbatim
337 *> INFO is INTEGER
338 *> If 0, then everything ran OK.
339 *> -1: NSIZES < 0
340 *> -2: Some MM(j) < 0
341 *> -3: Some NN(j) < 0
342 *> -4: NTYPES < 0
343 *> -7: THRESH < 0
344 *> -10: LDA < 1 or LDA < MMAX, where MMAX is max( MM(j) ).
345 *> -12: LDU < 1 or LDU < MMAX.
346 *> -14: LDVT < 1 or LDVT < NMAX, where NMAX is max( NN(j) ).
347 *> -21: LWORK too small.
348 *> If DLATMS, or DGESVD returns an error code, the
349 *> absolute value of it is returned.
350 *> \endverbatim
351 *
352 * Authors:
353 * ========
354 *
355 *> \author Univ. of Tennessee
356 *> \author Univ. of California Berkeley
357 *> \author Univ. of Colorado Denver
358 *> \author NAG Ltd.
359 *
360 *> \date June 2016
361 *
362 *> \ingroup double_eig
363 *
364 * =====================================================================
365  SUBROUTINE ddrvbd( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
366  $ A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S,
367  $ SSAV, E, WORK, LWORK, IWORK, NOUT, INFO )
368 *
369  IMPLICIT NONE
370 *
371 * -- LAPACK test routine (version 3.7.0) --
372 * -- LAPACK is a software package provided by Univ. of Tennessee, --
373 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
374 * June 2016
375 *
376 * .. Scalar Arguments ..
377  INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES,
378  $ NTYPES
379  DOUBLE PRECISION THRESH
380 * ..
381 * .. Array Arguments ..
382  LOGICAL DOTYPE( * )
383  INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
384  DOUBLE PRECISION A( LDA, * ), ASAV( LDA, * ), E( * ), S( * ),
385  $ ssav( * ), u( ldu, * ), usav( ldu, * ),
386  $ vt( ldvt, * ), vtsav( ldvt, * ), work( * )
387 * ..
388 *
389 * =====================================================================
390 *
391 * .. Parameters ..
392  DOUBLE PRECISION ZERO, ONE, TWO, HALF
393  PARAMETER ( ZERO = 0.0d0, one = 1.0d0, two = 2.0d0,
394  $ half = 0.5d0 )
395  INTEGER MAXTYP
396  PARAMETER ( MAXTYP = 5 )
397 * ..
398 * .. Local Scalars ..
399  LOGICAL BADMM, BADNN
400  CHARACTER JOBQ, JOBU, JOBVT, RANGE
401  CHARACTER*3 PATH
402  INTEGER I, IINFO, IJQ, IJU, IJVT, IL,IU, IWS, IWTMP,
403  $ itemp, j, jsize, jtype, lswork, m, minwrk,
404  $ mmax, mnmax, mnmin, mtypes, n, nfail,
405  $ nmax, ns, nsi, nsv, ntest
406  DOUBLE PRECISION ANORM, DIF, DIV, OVFL, RTUNFL, ULP,
407  $ ULPINV, UNFL, VL, VU
408 * ..
409 * .. Local Scalars for DGESVDQ ..
410  INTEGER LIWORK, LRWORK, NUMRANK
411 * ..
412 * .. Local Arrays for DGESVDQ ..
413  DOUBLE PRECISION RWORK( 2 )
414 * ..
415 * .. Local Arrays ..
416  CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 )
417  INTEGER IOLDSD( 4 ), ISEED2( 4 )
418  DOUBLE PRECISION RESULT( 39 )
419 * ..
420 * .. External Functions ..
421  DOUBLE PRECISION DLAMCH, DLARND
422  EXTERNAL DLAMCH, DLARND
423 * ..
424 * .. External Subroutines ..
425  EXTERNAL alasvm, dbdt01, dgejsv, dgesdd, dgesvd,
428 * ..
429 * .. Intrinsic Functions ..
430  INTRINSIC abs, dble, int, max, min
431 * ..
432 * .. Scalars in Common ..
433  LOGICAL LERR, OK
434  CHARACTER*32 SRNAMT
435  INTEGER INFOT, NUNIT
436 * ..
437 * .. Common blocks ..
438  COMMON / infoc / infot, nunit, ok, lerr
439  COMMON / srnamc / srnamt
440 * ..
441 * .. Data statements ..
442  DATA cjob / 'N', 'O', 'S', 'A' /
443  DATA cjobr / 'A', 'V', 'I' /
444  DATA cjobv / 'N', 'V' /
445 * ..
446 * .. Executable Statements ..
447 *
448 * Check for errors
449 *
450  info = 0
451  badmm = .false.
452  badnn = .false.
453  mmax = 1
454  nmax = 1
455  mnmax = 1
456  minwrk = 1
457  DO 10 j = 1, nsizes
458  mmax = max( mmax, mm( j ) )
459  IF( mm( j ).LT.0 )
460  $ badmm = .true.
461  nmax = max( nmax, nn( j ) )
462  IF( nn( j ).LT.0 )
463  $ badnn = .true.
464  mnmax = max( mnmax, min( mm( j ), nn( j ) ) )
465  minwrk = max( minwrk, max( 3*min( mm( j ),
466  $ nn( j ) )+max( mm( j ), nn( j ) ), 5*min( mm( j ),
467  $ nn( j )-4 ) )+2*min( mm( j ), nn( j ) )**2 )
468  10 CONTINUE
469 *
470 * Check for errors
471 *
472  IF( nsizes.LT.0 ) THEN
473  info = -1
474  ELSE IF( badmm ) THEN
475  info = -2
476  ELSE IF( badnn ) THEN
477  info = -3
478  ELSE IF( ntypes.LT.0 ) THEN
479  info = -4
480  ELSE IF( lda.LT.max( 1, mmax ) ) THEN
481  info = -10
482  ELSE IF( ldu.LT.max( 1, mmax ) ) THEN
483  info = -12
484  ELSE IF( ldvt.LT.max( 1, nmax ) ) THEN
485  info = -14
486  ELSE IF( minwrk.GT.lwork ) THEN
487  info = -21
488  END IF
489 *
490  IF( info.NE.0 ) THEN
491  CALL xerbla( 'DDRVBD', -info )
492  RETURN
493  END IF
494 *
495 * Initialize constants
496 *
497  path( 1: 1 ) = 'Double precision'
498  path( 2: 3 ) = 'BD'
499  nfail = 0
500  ntest = 0
501  unfl = dlamch( 'Safe minimum' )
502  ovfl = one / unfl
503  CALL dlabad( unfl, ovfl )
504  ulp = dlamch( 'Precision' )
505  rtunfl = sqrt( unfl )
506  ulpinv = one / ulp
507  infot = 0
508 *
509 * Loop over sizes, types
510 *
511  DO 240 jsize = 1, nsizes
512  m = mm( jsize )
513  n = nn( jsize )
514  mnmin = min( m, n )
515 *
516  IF( nsizes.NE.1 ) THEN
517  mtypes = min( maxtyp, ntypes )
518  ELSE
519  mtypes = min( maxtyp+1, ntypes )
520  END IF
521 *
522  DO 230 jtype = 1, mtypes
523  IF( .NOT.dotype( jtype ) )
524  $ GO TO 230
525 *
526  DO 20 j = 1, 4
527  ioldsd( j ) = iseed( j )
528  20 CONTINUE
529 *
530 * Compute "A"
531 *
532  IF( mtypes.GT.maxtyp )
533  $ GO TO 30
534 *
535  IF( jtype.EQ.1 ) THEN
536 *
537 * Zero matrix
538 *
539  CALL dlaset( 'Full', m, n, zero, zero, a, lda )
540 *
541  ELSE IF( jtype.EQ.2 ) THEN
542 *
543 * Identity matrix
544 *
545  CALL dlaset( 'Full', m, n, zero, one, a, lda )
546 *
547  ELSE
548 *
549 * (Scaled) random matrix
550 *
551  IF( jtype.EQ.3 )
552  $ anorm = one
553  IF( jtype.EQ.4 )
554  $ anorm = unfl / ulp
555  IF( jtype.EQ.5 )
556  $ anorm = ovfl*ulp
557  CALL dlatms( m, n, 'U', iseed, 'N', s, 4, dble( mnmin ),
558  $ anorm, m-1, n-1, 'N', a, lda, work, iinfo )
559  IF( iinfo.NE.0 ) THEN
560  WRITE( nout, fmt = 9996 )'Generator', iinfo, m, n,
561  $ jtype, ioldsd
562  info = abs( iinfo )
563  RETURN
564  END IF
565  END IF
566 *
567  30 CONTINUE
568  CALL dlacpy( 'F', m, n, a, lda, asav, lda )
569 *
570 * Do for minimal and adequate (for blocking) workspace
571 *
572  DO 220 iws = 1, 4
573 *
574  DO 40 j = 1, 32
575  result( j ) = -one
576  40 CONTINUE
577 *
578 * Test DGESVD: Factorize A
579 *
580  iwtmp = max( 3*min( m, n )+max( m, n ), 5*min( m, n ) )
581  lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
582  lswork = min( lswork, lwork )
583  lswork = max( lswork, 1 )
584  IF( iws.EQ.4 )
585  $ lswork = lwork
586 *
587  IF( iws.GT.1 )
588  $ CALL dlacpy( 'F', m, n, asav, lda, a, lda )
589  srnamt = 'DGESVD'
590  CALL dgesvd( 'A', 'A', m, n, a, lda, ssav, usav, ldu,
591  $ vtsav, ldvt, work, lswork, iinfo )
592  IF( iinfo.NE.0 ) THEN
593  WRITE( nout, fmt = 9995 )'GESVD', iinfo, m, n, jtype,
594  $ lswork, ioldsd
595  info = abs( iinfo )
596  RETURN
597  END IF
598 *
599 * Do tests 1--4
600 *
601  CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
602  $ vtsav, ldvt, work, result( 1 ) )
603  IF( m.NE.0 .AND. n.NE.0 ) THEN
604  CALL dort01( 'Columns', m, m, usav, ldu, work, lwork,
605  $ result( 2 ) )
606  CALL dort01( 'Rows', n, n, vtsav, ldvt, work, lwork,
607  $ result( 3 ) )
608  END IF
609  result( 4 ) = zero
610  DO 50 i = 1, mnmin - 1
611  IF( ssav( i ).LT.ssav( i+1 ) )
612  $ result( 4 ) = ulpinv
613  IF( ssav( i ).LT.zero )
614  $ result( 4 ) = ulpinv
615  50 CONTINUE
616  IF( mnmin.GE.1 ) THEN
617  IF( ssav( mnmin ).LT.zero )
618  $ result( 4 ) = ulpinv
619  END IF
620 *
621 * Do partial SVDs, comparing to SSAV, USAV, and VTSAV
622 *
623  result( 5 ) = zero
624  result( 6 ) = zero
625  result( 7 ) = zero
626  DO 80 iju = 0, 3
627  DO 70 ijvt = 0, 3
628  IF( ( iju.EQ.3 .AND. ijvt.EQ.3 ) .OR.
629  $ ( iju.EQ.1 .AND. ijvt.EQ.1 ) )GO TO 70
630  jobu = cjob( iju+1 )
631  jobvt = cjob( ijvt+1 )
632  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
633  srnamt = 'DGESVD'
634  CALL dgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,
635  $ vt, ldvt, work, lswork, iinfo )
636 *
637 * Compare U
638 *
639  dif = zero
640  IF( m.GT.0 .AND. n.GT.0 ) THEN
641  IF( iju.EQ.1 ) THEN
642  CALL dort03( 'C', m, mnmin, m, mnmin, usav,
643  $ ldu, a, lda, work, lwork, dif,
644  $ iinfo )
645  ELSE IF( iju.EQ.2 ) THEN
646  CALL dort03( 'C', m, mnmin, m, mnmin, usav,
647  $ ldu, u, ldu, work, lwork, dif,
648  $ iinfo )
649  ELSE IF( iju.EQ.3 ) THEN
650  CALL dort03( 'C', m, m, m, mnmin, usav, ldu,
651  $ u, ldu, work, lwork, dif,
652  $ iinfo )
653  END IF
654  END IF
655  result( 5 ) = max( result( 5 ), dif )
656 *
657 * Compare VT
658 *
659  dif = zero
660  IF( m.GT.0 .AND. n.GT.0 ) THEN
661  IF( ijvt.EQ.1 ) THEN
662  CALL dort03( 'R', n, mnmin, n, mnmin, vtsav,
663  $ ldvt, a, lda, work, lwork, dif,
664  $ iinfo )
665  ELSE IF( ijvt.EQ.2 ) THEN
666  CALL dort03( 'R', n, mnmin, n, mnmin, vtsav,
667  $ ldvt, vt, ldvt, work, lwork,
668  $ dif, iinfo )
669  ELSE IF( ijvt.EQ.3 ) THEN
670  CALL dort03( 'R', n, n, n, mnmin, vtsav,
671  $ ldvt, vt, ldvt, work, lwork,
672  $ dif, iinfo )
673  END IF
674  END IF
675  result( 6 ) = max( result( 6 ), dif )
676 *
677 * Compare S
678 *
679  dif = zero
680  div = max( mnmin*ulp*s( 1 ), unfl )
681  DO 60 i = 1, mnmin - 1
682  IF( ssav( i ).LT.ssav( i+1 ) )
683  $ dif = ulpinv
684  IF( ssav( i ).LT.zero )
685  $ dif = ulpinv
686  dif = max( dif, abs( ssav( i )-s( i ) ) / div )
687  60 CONTINUE
688  result( 7 ) = max( result( 7 ), dif )
689  70 CONTINUE
690  80 CONTINUE
691 *
692 * Test DGESDD: Factorize A
693 *
694  iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
695  lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
696  lswork = min( lswork, lwork )
697  lswork = max( lswork, 1 )
698  IF( iws.EQ.4 )
699  $ lswork = lwork
700 *
701  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
702  srnamt = 'DGESDD'
703  CALL dgesdd( 'A', m, n, a, lda, ssav, usav, ldu, vtsav,
704  $ ldvt, work, lswork, iwork, iinfo )
705  IF( iinfo.NE.0 ) THEN
706  WRITE( nout, fmt = 9995 )'GESDD', iinfo, m, n, jtype,
707  $ lswork, ioldsd
708  info = abs( iinfo )
709  RETURN
710  END IF
711 *
712 * Do tests 8--11
713 *
714  CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
715  $ vtsav, ldvt, work, result( 8 ) )
716  IF( m.NE.0 .AND. n.NE.0 ) THEN
717  CALL dort01( 'Columns', m, m, usav, ldu, work, lwork,
718  $ result( 9 ) )
719  CALL dort01( 'Rows', n, n, vtsav, ldvt, work, lwork,
720  $ result( 10 ) )
721  END IF
722  result( 11 ) = zero
723  DO 90 i = 1, mnmin - 1
724  IF( ssav( i ).LT.ssav( i+1 ) )
725  $ result( 11 ) = ulpinv
726  IF( ssav( i ).LT.zero )
727  $ result( 11 ) = ulpinv
728  90 CONTINUE
729  IF( mnmin.GE.1 ) THEN
730  IF( ssav( mnmin ).LT.zero )
731  $ result( 11 ) = ulpinv
732  END IF
733 *
734 * Do partial SVDs, comparing to SSAV, USAV, and VTSAV
735 *
736  result( 12 ) = zero
737  result( 13 ) = zero
738  result( 14 ) = zero
739  DO 110 ijq = 0, 2
740  jobq = cjob( ijq+1 )
741  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
742  srnamt = 'DGESDD'
743  CALL dgesdd( jobq, m, n, a, lda, s, u, ldu, vt, ldvt,
744  $ work, lswork, iwork, iinfo )
745 *
746 * Compare U
747 *
748  dif = zero
749  IF( m.GT.0 .AND. n.GT.0 ) THEN
750  IF( ijq.EQ.1 ) THEN
751  IF( m.GE.n ) THEN
752  CALL dort03( 'C', m, mnmin, m, mnmin, usav,
753  $ ldu, a, lda, work, lwork, dif,
754  $ info )
755  ELSE
756  CALL dort03( 'C', m, mnmin, m, mnmin, usav,
757  $ ldu, u, ldu, work, lwork, dif,
758  $ info )
759  END IF
760  ELSE IF( ijq.EQ.2 ) THEN
761  CALL dort03( 'C', m, mnmin, m, mnmin, usav, ldu,
762  $ u, ldu, work, lwork, dif, info )
763  END IF
764  END IF
765  result( 12 ) = max( result( 12 ), dif )
766 *
767 * Compare VT
768 *
769  dif = zero
770  IF( m.GT.0 .AND. n.GT.0 ) THEN
771  IF( ijq.EQ.1 ) THEN
772  IF( m.GE.n ) THEN
773  CALL dort03( 'R', n, mnmin, n, mnmin, vtsav,
774  $ ldvt, vt, ldvt, work, lwork,
775  $ dif, info )
776  ELSE
777  CALL dort03( 'R', n, mnmin, n, mnmin, vtsav,
778  $ ldvt, a, lda, work, lwork, dif,
779  $ info )
780  END IF
781  ELSE IF( ijq.EQ.2 ) THEN
782  CALL dort03( 'R', n, mnmin, n, mnmin, vtsav,
783  $ ldvt, vt, ldvt, work, lwork, dif,
784  $ info )
785  END IF
786  END IF
787  result( 13 ) = max( result( 13 ), dif )
788 *
789 * Compare S
790 *
791  dif = zero
792  div = max( mnmin*ulp*s( 1 ), unfl )
793  DO 100 i = 1, mnmin - 1
794  IF( ssav( i ).LT.ssav( i+1 ) )
795  $ dif = ulpinv
796  IF( ssav( i ).LT.zero )
797  $ dif = ulpinv
798  dif = max( dif, abs( ssav( i )-s( i ) ) / div )
799  100 CONTINUE
800  result( 14 ) = max( result( 14 ), dif )
801  110 CONTINUE
802 *
803 * Test DGESVDQ
804 * Note: DGESVDQ only works for M >= N
805 *
806  result( 36 ) = zero
807  result( 37 ) = zero
808  result( 38 ) = zero
809  result( 39 ) = zero
810 *
811  IF( m.GE.n ) THEN
812  iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
813  lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
814  lswork = min( lswork, lwork )
815  lswork = max( lswork, 1 )
816  IF( iws.EQ.4 )
817  $ lswork = lwork
818 *
819  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
820  srnamt = 'DGESVDQ'
821 *
822  lrwork = 2
823  liwork = max( n, 1 )
824  CALL dgesvdq( 'H', 'N', 'N', 'A', 'A',
825  $ m, n, a, lda, ssav, usav, ldu,
826  $ vtsav, ldvt, numrank, iwork, liwork,
827  $ work, lwork, rwork, lrwork, iinfo )
828 *
829  IF( iinfo.NE.0 ) THEN
830  WRITE( nout, fmt = 9995 )'DGESVDQ', iinfo, m, n,
831  $ jtype, lswork, ioldsd
832  info = abs( iinfo )
833  RETURN
834  END IF
835 *
836 * Do tests 36--39
837 *
838  CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
839  $ vtsav, ldvt, work, result( 36 ) )
840  IF( m.NE.0 .AND. n.NE.0 ) THEN
841  CALL dort01( 'Columns', m, m, usav, ldu, work,
842  $ lwork, result( 37 ) )
843  CALL dort01( 'Rows', n, n, vtsav, ldvt, work,
844  $ lwork, result( 38 ) )
845  END IF
846  result( 39 ) = zero
847  DO 199 i = 1, mnmin - 1
848  IF( ssav( i ).LT.ssav( i+1 ) )
849  $ result( 39 ) = ulpinv
850  IF( ssav( i ).LT.zero )
851  $ result( 39 ) = ulpinv
852  199 CONTINUE
853  IF( mnmin.GE.1 ) THEN
854  IF( ssav( mnmin ).LT.zero )
855  $ result( 39 ) = ulpinv
856  END IF
857  END IF
858 *
859 * Test DGESVJ
860 * Note: DGESVJ only works for M >= N
861 *
862  result( 15 ) = zero
863  result( 16 ) = zero
864  result( 17 ) = zero
865  result( 18 ) = zero
866 *
867  IF( m.GE.n ) THEN
868  iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
869  lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
870  lswork = min( lswork, lwork )
871  lswork = max( lswork, 1 )
872  IF( iws.EQ.4 )
873  $ lswork = lwork
874 *
875  CALL dlacpy( 'F', m, n, asav, lda, usav, lda )
876  srnamt = 'DGESVJ'
877  CALL dgesvj( 'G', 'U', 'V', m, n, usav, lda, ssav,
878  & 0, a, ldvt, work, lwork, info )
879 *
880 * DGESVJ returns V not VT
881 *
882  DO j=1,n
883  DO i=1,n
884  vtsav(j,i) = a(i,j)
885  END DO
886  END DO
887 *
888  IF( iinfo.NE.0 ) THEN
889  WRITE( nout, fmt = 9995 )'GESVJ', iinfo, m, n,
890  $ jtype, lswork, ioldsd
891  info = abs( iinfo )
892  RETURN
893  END IF
894 *
895 * Do tests 15--18
896 *
897  CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
898  $ vtsav, ldvt, work, result( 15 ) )
899  IF( m.NE.0 .AND. n.NE.0 ) THEN
900  CALL dort01( 'Columns', m, m, usav, ldu, work,
901  $ lwork, result( 16 ) )
902  CALL dort01( 'Rows', n, n, vtsav, ldvt, work,
903  $ lwork, result( 17 ) )
904  END IF
905  result( 18 ) = zero
906  DO 120 i = 1, mnmin - 1
907  IF( ssav( i ).LT.ssav( i+1 ) )
908  $ result( 18 ) = ulpinv
909  IF( ssav( i ).LT.zero )
910  $ result( 18 ) = ulpinv
911  120 CONTINUE
912  IF( mnmin.GE.1 ) THEN
913  IF( ssav( mnmin ).LT.zero )
914  $ result( 18 ) = ulpinv
915  END IF
916  END IF
917 *
918 * Test DGEJSV
919 * Note: DGEJSV only works for M >= N
920 *
921  result( 19 ) = zero
922  result( 20 ) = zero
923  result( 21 ) = zero
924  result( 22 ) = zero
925  IF( m.GE.n ) THEN
926  iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
927  lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
928  lswork = min( lswork, lwork )
929  lswork = max( lswork, 1 )
930  IF( iws.EQ.4 )
931  $ lswork = lwork
932 *
933  CALL dlacpy( 'F', m, n, asav, lda, vtsav, lda )
934  srnamt = 'DGEJSV'
935  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
936  & m, n, vtsav, lda, ssav, usav, ldu, a, ldvt,
937  & work, lwork, iwork, info )
938 *
939 * DGEJSV returns V not VT
940 *
941  DO 140 j=1,n
942  DO 130 i=1,n
943  vtsav(j,i) = a(i,j)
944  130 END DO
945  140 END DO
946 *
947  IF( iinfo.NE.0 ) THEN
948  WRITE( nout, fmt = 9995 )'GEJSV', iinfo, m, n,
949  $ jtype, lswork, ioldsd
950  info = abs( iinfo )
951  RETURN
952  END IF
953 *
954 * Do tests 19--22
955 *
956  CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
957  $ vtsav, ldvt, work, result( 19 ) )
958  IF( m.NE.0 .AND. n.NE.0 ) THEN
959  CALL dort01( 'Columns', m, m, usav, ldu, work,
960  $ lwork, result( 20 ) )
961  CALL dort01( 'Rows', n, n, vtsav, ldvt, work,
962  $ lwork, result( 21 ) )
963  END IF
964  result( 22 ) = zero
965  DO 150 i = 1, mnmin - 1
966  IF( ssav( i ).LT.ssav( i+1 ) )
967  $ result( 22 ) = ulpinv
968  IF( ssav( i ).LT.zero )
969  $ result( 22 ) = ulpinv
970  150 CONTINUE
971  IF( mnmin.GE.1 ) THEN
972  IF( ssav( mnmin ).LT.zero )
973  $ result( 22 ) = ulpinv
974  END IF
975  END IF
976 *
977 * Test DGESVDX
978 *
979  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
980  CALL dgesvdx( 'V', 'V', 'A', m, n, a, lda,
981  $ vl, vu, il, iu, ns, ssav, usav, ldu,
982  $ vtsav, ldvt, work, lwork, iwork,
983  $ iinfo )
984  IF( iinfo.NE.0 ) THEN
985  WRITE( nout, fmt = 9995 )'GESVDX', iinfo, m, n,
986  $ jtype, lswork, ioldsd
987  info = abs( iinfo )
988  RETURN
989  END IF
990 *
991 * Do tests 23--29
992 *
993  result( 23 ) = zero
994  result( 24 ) = zero
995  result( 25 ) = zero
996  CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
997  $ vtsav, ldvt, work, result( 23 ) )
998  IF( m.NE.0 .AND. n.NE.0 ) THEN
999  CALL dort01( 'Columns', m, m, usav, ldu, work, lwork,
1000  $ result( 24 ) )
1001  CALL dort01( 'Rows', n, n, vtsav, ldvt, work, lwork,
1002  $ result( 25 ) )
1003  END IF
1004  result( 26 ) = zero
1005  DO 160 i = 1, mnmin - 1
1006  IF( ssav( i ).LT.ssav( i+1 ) )
1007  $ result( 26 ) = ulpinv
1008  IF( ssav( i ).LT.zero )
1009  $ result( 26 ) = ulpinv
1010  160 CONTINUE
1011  IF( mnmin.GE.1 ) THEN
1012  IF( ssav( mnmin ).LT.zero )
1013  $ result( 26 ) = ulpinv
1014  END IF
1015 *
1016 * Do partial SVDs, comparing to SSAV, USAV, and VTSAV
1017 *
1018  result( 27 ) = zero
1019  result( 28 ) = zero
1020  result( 29 ) = zero
1021  DO 180 iju = 0, 1
1022  DO 170 ijvt = 0, 1
1023  IF( ( iju.EQ.0 .AND. ijvt.EQ.0 ) .OR.
1024  $ ( iju.EQ.1 .AND. ijvt.EQ.1 ) )GO TO 170
1025  jobu = cjobv( iju+1 )
1026  jobvt = cjobv( ijvt+1 )
1027  range = cjobr( 1 )
1028  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
1029  CALL dgesvdx( jobu, jobvt, range, m, n, a, lda,
1030  $ vl, vu, il, iu, ns, s, u, ldu,
1031  $ vt, ldvt, work, lwork, iwork,
1032  $ iinfo )
1033 *
1034 * Compare U
1035 *
1036  dif = zero
1037  IF( m.GT.0 .AND. n.GT.0 ) THEN
1038  IF( iju.EQ.1 ) THEN
1039  CALL dort03( 'C', m, mnmin, m, mnmin, usav,
1040  $ ldu, u, ldu, work, lwork, dif,
1041  $ iinfo )
1042  END IF
1043  END IF
1044  result( 27 ) = max( result( 27 ), dif )
1045 *
1046 * Compare VT
1047 *
1048  dif = zero
1049  IF( m.GT.0 .AND. n.GT.0 ) THEN
1050  IF( ijvt.EQ.1 ) THEN
1051  CALL dort03( 'R', n, mnmin, n, mnmin, vtsav,
1052  $ ldvt, vt, ldvt, work, lwork,
1053  $ dif, iinfo )
1054  END IF
1055  END IF
1056  result( 28 ) = max( result( 28 ), dif )
1057 *
1058 * Compare S
1059 *
1060  dif = zero
1061  div = max( mnmin*ulp*s( 1 ), unfl )
1062  DO 190 i = 1, mnmin - 1
1063  IF( ssav( i ).LT.ssav( i+1 ) )
1064  $ dif = ulpinv
1065  IF( ssav( i ).LT.zero )
1066  $ dif = ulpinv
1067  dif = max( dif, abs( ssav( i )-s( i ) ) / div )
1068  190 CONTINUE
1069  result( 29 ) = max( result( 29 ), dif )
1070  170 CONTINUE
1071  180 CONTINUE
1072 *
1073 * Do tests 30--32: DGESVDX( 'V', 'V', 'I' )
1074 *
1075  DO 200 i = 1, 4
1076  iseed2( i ) = iseed( i )
1077  200 CONTINUE
1078  IF( mnmin.LE.1 ) THEN
1079  il = 1
1080  iu = max( 1, mnmin )
1081  ELSE
1082  il = 1 + int( ( mnmin-1 )*dlarnd( 1, iseed2 ) )
1083  iu = 1 + int( ( mnmin-1 )*dlarnd( 1, iseed2 ) )
1084  IF( iu.LT.il ) THEN
1085  itemp = iu
1086  iu = il
1087  il = itemp
1088  END IF
1089  END IF
1090  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
1091  CALL dgesvdx( 'V', 'V', 'I', m, n, a, lda,
1092  $ vl, vu, il, iu, nsi, s, u, ldu,
1093  $ vt, ldvt, work, lwork, iwork,
1094  $ iinfo )
1095  IF( iinfo.NE.0 ) THEN
1096  WRITE( nout, fmt = 9995 )'GESVDX', iinfo, m, n,
1097  $ jtype, lswork, ioldsd
1098  info = abs( iinfo )
1099  RETURN
1100  END IF
1101 *
1102  result( 30 ) = zero
1103  result( 31 ) = zero
1104  result( 32 ) = zero
1105  CALL dbdt05( m, n, asav, lda, s, nsi, u, ldu,
1106  $ vt, ldvt, work, result( 30 ) )
1107  CALL dort01( 'Columns', m, nsi, u, ldu, work, lwork,
1108  $ result( 31 ) )
1109  CALL dort01( 'Rows', nsi, n, vt, ldvt, work, lwork,
1110  $ result( 32 ) )
1111 *
1112 * Do tests 33--35: DGESVDX( 'V', 'V', 'V' )
1113 *
1114  IF( mnmin.GT.0 .AND. nsi.GT.1 ) THEN
1115  IF( il.NE.1 ) THEN
1116  vu = ssav( il ) +
1117  $ max( half*abs( ssav( il )-ssav( il-1 ) ),
1118  $ ulp*anorm, two*rtunfl )
1119  ELSE
1120  vu = ssav( 1 ) +
1121  $ max( half*abs( ssav( ns )-ssav( 1 ) ),
1122  $ ulp*anorm, two*rtunfl )
1123  END IF
1124  IF( iu.NE.ns ) THEN
1125  vl = ssav( iu ) - max( ulp*anorm, two*rtunfl,
1126  $ half*abs( ssav( iu+1 )-ssav( iu ) ) )
1127  ELSE
1128  vl = ssav( ns ) - max( ulp*anorm, two*rtunfl,
1129  $ half*abs( ssav( ns )-ssav( 1 ) ) )
1130  END IF
1131  vl = max( vl,zero )
1132  vu = max( vu,zero )
1133  IF( vl.GE.vu ) vu = max( vu*2, vu+vl+half )
1134  ELSE
1135  vl = zero
1136  vu = one
1137  END IF
1138  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
1139  CALL dgesvdx( 'V', 'V', 'V', m, n, a, lda,
1140  $ vl, vu, il, iu, nsv, s, u, ldu,
1141  $ vt, ldvt, work, lwork, iwork,
1142  $ iinfo )
1143  IF( iinfo.NE.0 ) THEN
1144  WRITE( nout, fmt = 9995 )'GESVDX', iinfo, m, n,
1145  $ jtype, lswork, ioldsd
1146  info = abs( iinfo )
1147  RETURN
1148  END IF
1149 *
1150  result( 33 ) = zero
1151  result( 34 ) = zero
1152  result( 35 ) = zero
1153  CALL dbdt05( m, n, asav, lda, s, nsv, u, ldu,
1154  $ vt, ldvt, work, result( 33 ) )
1155  CALL dort01( 'Columns', m, nsv, u, ldu, work, lwork,
1156  $ result( 34 ) )
1157  CALL dort01( 'Rows', nsv, n, vt, ldvt, work, lwork,
1158  $ result( 35 ) )
1159 *
1160 * End of Loop -- Check for RESULT(j) > THRESH
1161 *
1162  DO 210 j = 1, 39
1163  IF( result( j ).GE.thresh ) THEN
1164  IF( nfail.EQ.0 ) THEN
1165  WRITE( nout, fmt = 9999 )
1166  WRITE( nout, fmt = 9998 )
1167  END IF
1168  WRITE( nout, fmt = 9997 )m, n, jtype, iws, ioldsd,
1169  $ j, result( j )
1170  nfail = nfail + 1
1171  END IF
1172  210 CONTINUE
1173  ntest = ntest + 39
1174  220 CONTINUE
1175  230 CONTINUE
1176  240 CONTINUE
1177 *
1178 * Summary
1179 *
1180  CALL alasvm( path, nout, nfail, ntest, 0 )
1181 *
1182  9999 FORMAT( ' SVD -- Real Singular Value Decomposition Driver ',
1183  $ / ' Matrix types (see DDRVBD for details):',
1184  $ / / ' 1 = Zero matrix', / ' 2 = Identity matrix',
1185  $ / ' 3 = Evenly spaced singular values near 1',
1186  $ / ' 4 = Evenly spaced singular values near underflow',
1187  $ / ' 5 = Evenly spaced singular values near overflow', / /
1188  $ ' Tests performed: ( A is dense, U and V are orthogonal,',
1189  $ / 19x, ' S is an array, and Upartial, VTpartial, and',
1190  $ / 19x, ' Spartial are partially computed U, VT and S),', / )
1191  9998 FORMAT( ' 1 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1192  $ / ' 2 = | I - U**T U | / ( M ulp ) ',
1193  $ / ' 3 = | I - VT VT**T | / ( N ulp ) ',
1194  $ / ' 4 = 0 if S contains min(M,N) nonnegative values in',
1195  $ ' decreasing order, else 1/ulp',
1196  $ / ' 5 = | U - Upartial | / ( M ulp )',
1197  $ / ' 6 = | VT - VTpartial | / ( N ulp )',
1198  $ / ' 7 = | S - Spartial | / ( min(M,N) ulp |S| )',
1199  $ / ' 8 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1200  $ / ' 9 = | I - U**T U | / ( M ulp ) ',
1201  $ / '10 = | I - VT VT**T | / ( N ulp ) ',
1202  $ / '11 = 0 if S contains min(M,N) nonnegative values in',
1203  $ ' decreasing order, else 1/ulp',
1204  $ / '12 = | U - Upartial | / ( M ulp )',
1205  $ / '13 = | VT - VTpartial | / ( N ulp )',
1206  $ / '14 = | S - Spartial | / ( min(M,N) ulp |S| )',
1207  $ / '15 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1208  $ / '16 = | I - U**T U | / ( M ulp ) ',
1209  $ / '17 = | I - VT VT**T | / ( N ulp ) ',
1210  $ / '18 = 0 if S contains min(M,N) nonnegative values in',
1211  $ ' decreasing order, else 1/ulp',
1212  $ / '19 = | U - Upartial | / ( M ulp )',
1213  $ / '20 = | VT - VTpartial | / ( N ulp )',
1214  $ / '21 = | S - Spartial | / ( min(M,N) ulp |S| )',
1215  $ / '22 = 0 if S contains min(M,N) nonnegative values in',
1216  $ ' decreasing order, else 1/ulp',
1217  $ / '23 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ),',
1218  $ ' DGESVDX(V,V,A) ',
1219  $ / '24 = | I - U**T U | / ( M ulp ) ',
1220  $ / '25 = | I - VT VT**T | / ( N ulp ) ',
1221  $ / '26 = 0 if S contains min(M,N) nonnegative values in',
1222  $ ' decreasing order, else 1/ulp',
1223  $ / '27 = | U - Upartial | / ( M ulp )',
1224  $ / '28 = | VT - VTpartial | / ( N ulp )',
1225  $ / '29 = | S - Spartial | / ( min(M,N) ulp |S| )',
1226  $ / '30 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp ),',
1227  $ ' DGESVDX(V,V,I) ',
1228  $ / '31 = | I - U**T U | / ( M ulp ) ',
1229  $ / '32 = | I - VT VT**T | / ( N ulp ) ',
1230  $ / '33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp ),',
1231  $ ' DGESVDX(V,V,V) ',
1232  $ / '34 = | I - U**T U | / ( M ulp ) ',
1233  $ / '35 = | I - VT VT**T | / ( N ulp ) ',
1234  $ ' DGESVDQ(H,N,N,A,A',
1235  $ / '36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1236  $ / '37 = | I - U**T U | / ( M ulp ) ',
1237  $ / '38 = | I - VT VT**T | / ( N ulp ) ',
1238  $ / '39 = 0 if S contains min(M,N) nonnegative values in',
1239  $ ' decreasing order, else 1/ulp',
1240  $ / / )
1241  9997 FORMAT( ' M=', i5, ', N=', i5, ', type ', i1, ', IWS=', i1,
1242  $ ', seed=', 4( i4, ',' ), ' test(', i2, ')=', g11.4 )
1243  9996 FORMAT( ' DDRVBD: ', a, ' returned INFO=', i6, '.', / 9x, 'M=',
1244  $ i6, ', N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ),
1245  $ i5, ')' )
1246  9995 FORMAT( ' DDRVBD: ', a, ' returned INFO=', i6, '.', / 9x, 'M=',
1247  $ i6, ', N=', i6, ', JTYPE=', i6, ', LSWORK=', i6, / 9x,
1248  $ 'ISEED=(', 3( i5, ',' ), i5, ')' )
1249 *
1250  RETURN
1251 *
1252 * End of DDRVBD
1253 *
1254  END
dlatms
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
dgesvj
subroutine dgesvj(JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LDV, WORK, LWORK, INFO)
DGESVJ
Definition: dgesvj.f:339
dort03
subroutine dort03(RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK, RESULT, INFO)
DORT03
Definition: dort03.f:158
dort01
subroutine dort01(ROWCOL, M, N, U, LDU, WORK, LWORK, RESID)
DORT01
Definition: dort01.f:118
dgesdd
subroutine dgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
DGESDD
Definition: dgesdd.f:220
dbdt01
subroutine dbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RESID)
DBDT01
Definition: dbdt01.f:142
dgesvd
subroutine dgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, INFO)
DGESVD computes the singular value decomposition (SVD) for GE matrices
Definition: dgesvd.f:213
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
dgesvdq
subroutine dgesvdq(JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK, WORK, LWORK, RWORK, LRWORK, INFO)
DGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE...
Definition: dgesvdq.f:417
ddrvbd
subroutine ddrvbd(NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH, A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S, SSAV, E, WORK, LWORK, IWORK, NOUT, INFO)
DDRVBD
Definition: ddrvbd.f:368
dbdt05
subroutine dbdt05(M, N, A, LDA, S, NS, U, LDU, VT, LDVT, WORK, RESID)
Definition: dbdt05.f:127
dlabad
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
dlaset
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: dlaset.f:112
dgesvdx
subroutine dgesvdx(JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, IL, IU, NS, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
DGESVDX computes the singular value decomposition (SVD) for GE matrices
Definition: dgesvdx.f:265
dlacpy
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
dgejsv
subroutine dgejsv(JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, M, N, A, LDA, SVA, U, LDU, V, LDV, WORK, LWORK, IWORK, INFO)
DGEJSV
Definition: dgejsv.f:478