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