LAPACK  3.6.0
LAPACK: Linear Algebra PACKage
cdrvbd.f
Go to the documentation of this file.
1 *> \brief \b CDRVBD
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 CDRVBD( 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 * REAL THRESH
20 * ..
21 * .. Array Arguments ..
22 * LOGICAL DOTYPE( * )
23 * INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
24 * REAL E( * ), RWORK( * ), S( * ), SSAV( * )
25 * COMPLEX 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 *> CDRVBD checks the singular value decomposition (SVD) driver CGESVD
37 *> and CGESDD.
38 *> CGESVD and CGESDD 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 CDRVBD 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 CGESVD:
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 CGESDD:
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 CGESVJ:
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 CGEJSV:
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 CGESVDX( 'V', 'V', 'A' )/CGESVDX( '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 CGESVDX( '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 CGESVDX( '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 *> CDRVBD 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, CDRVBD
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 CDRVBD to continue the same random number
227 *> sequence.
228 *> \endverbatim
229 *>
230 *> \param[in] THRESH
231 *> \verbatim
232 *> THRESH is REAL
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 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 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 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 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 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 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 REAL array, dimension (max(min(MM,NN)))
311 *> Contains the computed singular values.
312 *> \endverbatim
313 *>
314 *> \param[out] SSAV
315 *> \verbatim
316 *> SSAV is REAL 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 REAL array, dimension (max(min(MM,NN)))
323 *> Workspace for CGESVD.
324 *> \endverbatim
325 *>
326 *> \param[out] WORK
327 *> \verbatim
328 *> WORK is COMPLEX 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 REAL 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 *> -29: LWORK too small.
370 *> If CLATMS, or CGESVD 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 November 2015
383 *
384 *> \ingroup complex_eig
385 *
386 * =====================================================================
387  SUBROUTINE cdrvbd( 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.0) --
393 * -- LAPACK is a software package provided by Univ. of Tennessee, --
394 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
395 * November 2015
396 *
397 * .. Scalar Arguments ..
398  INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUNIT, NSIZES,
399  $ ntypes
400  REAL THRESH
401 * ..
402 * .. Array Arguments ..
403  LOGICAL DOTYPE( * )
404  INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
405  REAL E( * ), RWORK( * ), S( * ), SSAV( * )
406  COMPLEX A( lda, * ), ASAV( lda, * ), U( ldu, * ),
407  $ usav( ldu, * ), vt( ldvt, * ),
408  $ vtsav( ldvt, * ), work( * )
409 * ..
410 *
411 * =====================================================================
412 *
413 * .. Parameters ..
414  REAL ZERO, ONE, TWO, HALF
415  parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
416  $ half = 0.5e0 )
417  COMPLEX CZERO, CONE
418  parameter( czero = ( 0.0e+0, 0.0e+0 ),
419  $ cone = ( 1.0e+0, 0.0e+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, IWSPC,
427  $ iwtmp, j, jsize, jtype, lswork, m, minwrk,
428  $ mmax, mnmax, mnmin, mtypes, n, nerrs, nfail,
429  $ nmax, ns, nsi, nsv, ntest, ntestf, ntestt,
430  $ lrwork
431  REAL 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  REAL RESULT( 35 )
438 * ..
439 * .. External Functions ..
440  REAL SLAMCH, SLARND
441  EXTERNAL slamch, slarnd
442 * ..
443 * .. External Subroutines ..
444  EXTERNAL alasvm, xerbla, cbdt01, cbdt05, cgesdd, cgesvd,
446  $ cunt01, cunt03
447 * ..
448 * .. Intrinsic Functions ..
449  INTRINSIC abs, REAL, 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( 'CDRVBD', -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 = slamch( 'S' )
525  ovfl = one / unfl
526  ulp = slamch( 'E' )
527  ulpinv = one / ulp
528  rtunfl = sqrt( unfl )
529 *
530 * Loop over sizes, types
531 *
532  nerrs = 0
533 *
534  DO 310 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 300 jtype = 1, mtypes
546  IF( .NOT.dotype( jtype ) )
547  $ GO TO 300
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 claset( '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 claset( '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 clatms( m, n, 'U', iseed, 'N', s, 4, REAL( 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 clacpy( 'F', m, n, a, lda, asav, lda )
599 *
600 * Do for minimal and adequate (for blocking) workspace
601 *
602  DO 290 iwspc = 1, 4
603 *
604 * Test for CGESVD
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 clacpy( 'F', m, n, asav, lda, a, lda )
621  srnamt = 'CGESVD'
622  CALL cgesvd( '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 cbdt01( 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 cunt01( 'Columns', mnmin, m, usav, ldu, work,
637  $ lwork, rwork, result( 2 ) )
638  CALL cunt01( '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 clacpy( 'F', m, n, asav, lda, a, lda )
665  srnamt = 'CGESVD'
666  CALL cgesvd( 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 cunt03( '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 cunt03( '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 cunt03( '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 cunt03( '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 cunt03( '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 cunt03( '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( REAL( mnmin )*ULP*S( 1 ),
713  $ slamch( '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 CGESDD
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 clacpy( 'F', m, n, asav, lda, a, lda )
737  srnamt = 'CGESDD'
738  CALL cgesdd( '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 cbdt01( 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 cunt01( 'Columns', mnmin, m, usav, ldu, work,
753  $ lwork, rwork, result( 9 ) )
754  CALL cunt01( '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 clacpy( 'F', m, n, asav, lda, a, lda )
777  srnamt = 'CGESDD'
778  CALL cgesdd( 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 cunt03( 'C', m, mnmin, m, mnmin, usav,
788  $ ldu, a, lda, work, lwork, rwork,
789  $ dif, iinfo )
790  ELSE
791  CALL cunt03( '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 cunt03( '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 cunt03( 'R', n, mnmin, n, mnmin, vtsav,
810  $ ldvt, vt, ldvt, work, lwork,
811  $ rwork, dif, iinfo )
812  ELSE
813  CALL cunt03( '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 cunt03( '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( REAL( mnmin )*ULP*S( 1 ),
829  $ slamch( '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 CGESVJ: Factorize A
842 * Note: CGESVJ 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 clacpy( 'F', m, n, asav, lda, usav, lda )
859  srnamt = 'CGESVJ'
860  CALL cgesvj( 'G', 'U', 'V', m, n, usav, lda, ssav,
861  & 0, a, ldvt, work, lwork, rwork,
862  & lrwork, iinfo )
863 *
864 * CGESVJ 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 cbdt01( 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 cunt01( 'Columns', m, m, usav, ldu, work,
886  $ lwork, rwork, result( 16 ) )
887  CALL cunt01( '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 CGEJSV: Factorize A
904 * Note: CGEJSV 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 clacpy( 'F', m, n, asav, lda, vtsav, lda )
920  srnamt = 'CGEJSV'
921  CALL cgejsv( '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 * CGEJSV 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 cbdt01( 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 cunt01( 'Columns', m, m, usav, ldu, work,
948  $ lwork, rwork, result( 20 ) )
949  CALL cunt01( '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 CGESVDX
966 *
967 * Factorize A
968 *
969  CALL clacpy( 'F', m, n, asav, lda, a, lda )
970  srnamt = 'CGESVDX'
971  CALL cgesvdx( '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 cbdt01( 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 cunt01( 'Columns', mnmin, m, usav, ldu, work,
991  $ lwork, rwork, result( 24 ) )
992  CALL cunt01( '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 clacpy( 'F', m, n, asav, lda, a, lda )
1020  srnamt = 'CGESVDX'
1021  CALL cgesvdx( 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 cunt03( '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 cunt03( '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( REAL( mnmin )*ULP*S( 1 ),
1054  $ slamch( '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 )*slarnd( 1, iseed2 ) )
1076  iu = 1 + int( ( mnmin-1 )*slarnd( 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 clacpy( 'F', m, n, asav, lda, a, lda )
1084  srnamt = 'CGESVDX'
1085  CALL cgesvdx( '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 cbdt05( 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 cunt01( 'Columns', m, nsi, u, ldu, work,
1103  $ lwork, rwork, result( 31 ) )
1104  CALL cunt01( '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 clacpy( 'F', m, n, asav, lda, a, lda )
1135  srnamt = 'CGESVDX'
1136  CALL cgesvdx( '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 cbdt05( 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 cunt01( 'Columns', m, nsv, u, ldu, work,
1154  $ lwork, rwork, result( 34 ) )
1155  CALL cunt01( '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  290 CONTINUE
1189 *
1190  300 CONTINUE
1191  310 CONTINUE
1192 *
1193 * Summary
1194 *
1195  CALL alasvm( 'CBD', nounit, nerrs, ntestt, 0 )
1196 *
1197  9999 FORMAT( ' SVD -- Complex Singular Value Decomposition Driver ',
1198  $ / ' Matrix types (see CDRVBD 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  $ / ' CGESVD: ', /
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  $ / ' CGESDD: ', /
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  $ / ' CGESVJ: ', /
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  $ / ' CGESJV: ', /
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  $ / ' CGESVDX(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  $ / ' CGESVDX(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  $ / ' CGESVDX(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( ' CDRVBD: ', a, ' returned INFO=', i6, '.', / 9x, 'M=',
1258  $ i6, ', N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ),
1259  $ i5, ')' )
1260  9995 FORMAT( ' CDRVBD: ', 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 CDRVBD
1267 *
1268  END
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine cgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, INFO)
CGESVD computes the singular value decomposition (SVD) for GE matrices
Definition: cgesvd.f:216
subroutine cgesvdx(JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, IL, IU, NS, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, IWORK, INFO)
CGESVDX computes the singular value decomposition (SVD) for GE matrices
Definition: cgesvdx.f:266
subroutine cdrvbd(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)
CDRVBD
Definition: cdrvbd.f:391
subroutine cgejsv(JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, M, N, A, LDA, SVA, U, LDU, V, LDV, CWORK, LWORK, RWORK, LRWORK, IWORK, INFO)
CGEJSV
Definition: cgejsv.f:518
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine cunt03(RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK, RWORK, RESULT, INFO)
CUNT03
Definition: cunt03.f:164
subroutine cgesvj(JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LDV, CWORK, LWORK, RWORK, LRWORK, INFO)
CGESVJ
Definition: cgesvj.f:328
subroutine cunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
CUNT01
Definition: cunt01.f:128
subroutine cgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, IWORK, INFO)
CGESDD
Definition: cgesdd.f:224
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
subroutine cbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RWORK, RESID)
CBDT01
Definition: cbdt01.f:148
subroutine cbdt05(M, N, A, LDA, S, NS, U, LDU, VT, LDVT, WORK, RESID)
Definition: cbdt05.f:125