1 SUBROUTINE DDRVBD( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
2 $ A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S,
3 $ SSAV, E, WORK, LWORK, IWORK, NOUT, INFO )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES,
11 $ NTYPES
12 DOUBLE PRECISION THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
17 DOUBLE PRECISION A( LDA, * ), ASAV( LDA, * ), E( * ), S( * ),
18 $ SSAV( * ), U( LDU, * ), USAV( LDU, * ),
19 $ VT( LDVT, * ), VTSAV( LDVT, * ), WORK( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * DDRVBD checks the singular value decomposition (SVD) drivers
26 * DGESVD, DGESDD, DGESVJ, and DGEJSV.
27 *
28 * Both DGESVD and DGESDD factor A = U diag(S) VT, where U and VT are
29 * orthogonal and diag(S) is diagonal with the entries of the array S
30 * on its diagonal. The entries of S are the singular values,
31 * nonnegative and stored in decreasing order. U and VT can be
32 * optionally not computed, overwritten on A, or computed partially.
33 *
34 * A is M by N. Let MNMIN = min( M, N ). S has dimension MNMIN.
35 * U can be M by M or M by MNMIN. VT can be N by N or MNMIN by N.
36 *
37 * When DDRVBD is called, a number of matrix "sizes" (M's and N's)
38 * and a number of matrix "types" are specified. For each size (M,N)
39 * and each type of matrix, and for the minimal workspace as well as
40 * workspace adequate to permit blocking, an M x N matrix "A" will be
41 * generated and used to test the SVD routines. For each matrix, A will
42 * be factored as A = U diag(S) VT and the following 12 tests computed:
43 *
44 * Test for DGESVD:
45 *
46 * (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
47 *
48 * (2) | I - U'U | / ( M ulp )
49 *
50 * (3) | I - VT VT' | / ( N ulp )
51 *
52 * (4) S contains MNMIN nonnegative values in decreasing order.
53 * (Return 0 if true, 1/ULP if false.)
54 *
55 * (5) | U - Upartial | / ( M ulp ) where Upartial is a partially
56 * computed U.
57 *
58 * (6) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
59 * computed VT.
60 *
61 * (7) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
62 * vector of singular values from the partial SVD
63 *
64 * Test for DGESDD:
65 *
66 * (8) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
67 *
68 * (9) | I - U'U | / ( M ulp )
69 *
70 * (10) | I - VT VT' | / ( N ulp )
71 *
72 * (11) S contains MNMIN nonnegative values in decreasing order.
73 * (Return 0 if true, 1/ULP if false.)
74 *
75 * (12) | U - Upartial | / ( M ulp ) where Upartial is a partially
76 * computed U.
77 *
78 * (13) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
79 * computed VT.
80 *
81 * (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
82 * vector of singular values from the partial SVD
83 *
84 * Test for SGESVJ:
85 *
86 * (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
87 *
88 * (16) | I - U'U | / ( M ulp )
89 *
90 * (17) | I - VT VT' | / ( N ulp )
91 *
92 * (18) S contains MNMIN nonnegative values in decreasing order.
93 * (Return 0 if true, 1/ULP if false.)
94 *
95 * Test for SGEJSV:
96 *
97 * (19) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
98 *
99 * (20) | I - U'U | / ( M ulp )
100 *
101 * (21) | I - VT VT' | / ( N ulp )
102 *
103 * (22) S contains MNMIN nonnegative values in decreasing order.
104 * (Return 0 if true, 1/ULP if false.)
105 *
106 * The "sizes" are specified by the arrays MM(1:NSIZES) and
107 * NN(1:NSIZES); the value of each element pair (MM(j),NN(j))
108 * specifies one size. The "types" are specified by a logical array
109 * DOTYPE( 1:NTYPES ); if DOTYPE(j) is .TRUE., then matrix type "j"
110 * will be generated.
111 * Currently, the list of possible types is:
112 *
113 * (1) The zero matrix.
114 * (2) The identity matrix.
115 * (3) A matrix of the form U D V, where U and V are orthogonal and
116 * D has evenly spaced entries 1, ..., ULP with random signs
117 * on the diagonal.
118 * (4) Same as (3), but multiplied by the underflow-threshold / ULP.
119 * (5) Same as (3), but multiplied by the overflow-threshold * ULP.
120 *
121 * Arguments
122 * ==========
123 *
124 * NSIZES (input) INTEGER
125 * The number of matrix sizes (M,N) contained in the vectors
126 * MM and NN.
127 *
128 * MM (input) INTEGER array, dimension (NSIZES)
129 * The values of the matrix row dimension M.
130 *
131 * NN (input) INTEGER array, dimension (NSIZES)
132 * The values of the matrix column dimension N.
133 *
134 * NTYPES (input) INTEGER
135 * The number of elements in DOTYPE. If it is zero, DDRVBD
136 * does nothing. It must be at least zero. If it is MAXTYP+1
137 * and NSIZES is 1, then an additional type, MAXTYP+1 is
138 * defined, which is to use whatever matrices are in A and B.
139 * This is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
140 * DOTYPE(MAXTYP+1) is .TRUE. .
141 *
142 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
143 * If DOTYPE(j) is .TRUE., then for each size (m,n), a matrix
144 * of type j will be generated. If NTYPES is smaller than the
145 * maximum number of types defined (PARAMETER MAXTYP), then
146 * types NTYPES+1 through MAXTYP will not be generated. If
147 * NTYPES is larger than MAXTYP, DOTYPE(MAXTYP+1) through
148 * DOTYPE(NTYPES) will be ignored.
149 *
150 * ISEED (input/output) INTEGER array, dimension (4)
151 * On entry, the seed of the random number generator. The array
152 * elements should be between 0 and 4095; if not they will be
153 * reduced mod 4096. Also, ISEED(4) must be odd.
154 * On exit, ISEED is changed and can be used in the next call to
155 * DDRVBD to continue the same random number sequence.
156 *
157 * THRESH (input) DOUBLE PRECISION
158 * The threshold value for the test ratios. A result is
159 * included in the output file if RESULT >= THRESH. The test
160 * ratios are scaled to be O(1), so THRESH should be a small
161 * multiple of 1, e.g., 10 or 100. To have every test ratio
162 * printed, use THRESH = 0.
163 *
164 * A (workspace) DOUBLE PRECISION array, dimension (LDA,NMAX)
165 * where NMAX is the maximum value of N in NN.
166 *
167 * LDA (input) INTEGER
168 * The leading dimension of the array A. LDA >= max(1,MMAX),
169 * where MMAX is the maximum value of M in MM.
170 *
171 * U (workspace) DOUBLE PRECISION array, dimension (LDU,MMAX)
172 *
173 * LDU (input) INTEGER
174 * The leading dimension of the array U. LDU >= max(1,MMAX).
175 *
176 * VT (workspace) DOUBLE PRECISION array, dimension (LDVT,NMAX)
177 *
178 * LDVT (input) INTEGER
179 * The leading dimension of the array VT. LDVT >= max(1,NMAX).
180 *
181 * ASAV (workspace) DOUBLE PRECISION array, dimension (LDA,NMAX)
182 *
183 * USAV (workspace) DOUBLE PRECISION array, dimension (LDU,MMAX)
184 *
185 * VTSAV (workspace) DOUBLE PRECISION array, dimension (LDVT,NMAX)
186 *
187 * S (workspace) DOUBLE PRECISION array, dimension
188 * (max(min(MM,NN)))
189 *
190 * SSAV (workspace) DOUBLE PRECISION array, dimension
191 * (max(min(MM,NN)))
192 *
193 * E (workspace) DOUBLE PRECISION array, dimension
194 * (max(min(MM,NN)))
195 *
196 * WORK (workspace) DOUBLE PRECISION array, dimension (LWORK)
197 *
198 * LWORK (input) INTEGER
199 * The number of entries in WORK. This must be at least
200 * max(3*MN+MX,5*MN-4)+2*MN**2 for all pairs
201 * pairs (MN,MX)=( min(MM(j),NN(j), max(MM(j),NN(j)) )
202 *
203 * IWORK (workspace) INTEGER array, dimension at least 8*min(M,N)
204 *
205 * NOUT (input) INTEGER
206 * The FORTRAN unit number for printing out error messages
207 * (e.g., if a routine returns IINFO not equal to 0.)
208 *
209 * INFO (output) INTEGER
210 * If 0, then everything ran OK.
211 * -1: NSIZES < 0
212 * -2: Some MM(j) < 0
213 * -3: Some NN(j) < 0
214 * -4: NTYPES < 0
215 * -7: THRESH < 0
216 * -10: LDA < 1 or LDA < MMAX, where MMAX is max( MM(j) ).
217 * -12: LDU < 1 or LDU < MMAX.
218 * -14: LDVT < 1 or LDVT < NMAX, where NMAX is max( NN(j) ).
219 * -21: LWORK too small.
220 * If DLATMS, or DGESVD returns an error code, the
221 * absolute value of it is returned.
222 *
223 * =====================================================================
224 *
225 * .. Parameters ..
226 DOUBLE PRECISION ZERO, ONE
227 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
228 INTEGER MAXTYP
229 PARAMETER ( MAXTYP = 5 )
230 * ..
231 * .. Local Scalars ..
232 LOGICAL BADMM, BADNN
233 CHARACTER JOBQ, JOBU, JOBVT
234 CHARACTER*3 PATH
235 INTEGER I, IINFO, IJQ, IJU, IJVT, IWS, IWTMP, J, JSIZE,
236 $ JTYPE, LSWORK, M, MINWRK, MMAX, MNMAX, MNMIN,
237 $ MTYPES, N, NFAIL, NMAX, NTEST
238 DOUBLE PRECISION ANORM, DIF, DIV, OVFL, ULP, ULPINV, UNFL
239 * ..
240 * .. Local Arrays ..
241 CHARACTER CJOB( 4 )
242 INTEGER IOLDSD( 4 )
243 DOUBLE PRECISION RESULT( 22 )
244 * ..
245 * .. External Functions ..
246 DOUBLE PRECISION DLAMCH
247 EXTERNAL DLAMCH
248 * ..
249 * .. External Subroutines ..
250 EXTERNAL ALASVM, DBDT01, DGESDD, DGESVD, DLABAD, DLACPY,
251 $ DLASET, DLATMS, DORT01, DORT03, XERBLA, DGESVJ,
252 $ DGEJSV
253 * ..
254 * .. Intrinsic Functions ..
255 INTRINSIC ABS, DBLE, MAX, MIN
256 * ..
257 * .. Scalars in Common ..
258 LOGICAL LERR, OK
259 CHARACTER*32 SRNAMT
260 INTEGER INFOT, NUNIT
261 * ..
262 * .. Common blocks ..
263 COMMON / INFOC / INFOT, NUNIT, OK, LERR
264 COMMON / SRNAMC / SRNAMT
265 * ..
266 * .. Data statements ..
267 DATA CJOB / 'N', 'O', 'S', 'A' /
268 * ..
269 * .. Executable Statements ..
270 *
271 * Check for errors
272 *
273 INFO = 0
274 BADMM = .FALSE.
275 BADNN = .FALSE.
276 MMAX = 1
277 NMAX = 1
278 MNMAX = 1
279 MINWRK = 1
280 DO 10 J = 1, NSIZES
281 MMAX = MAX( MMAX, MM( J ) )
282 IF( MM( J ).LT.0 )
283 $ BADMM = .TRUE.
284 NMAX = MAX( NMAX, NN( J ) )
285 IF( NN( J ).LT.0 )
286 $ BADNN = .TRUE.
287 MNMAX = MAX( MNMAX, MIN( MM( J ), NN( J ) ) )
288 MINWRK = MAX( MINWRK, MAX( 3*MIN( MM( J ),
289 $ NN( J ) )+MAX( MM( J ), NN( J ) ), 5*MIN( MM( J ),
290 $ NN( J )-4 ) )+2*MIN( MM( J ), NN( J ) )**2 )
291 10 CONTINUE
292 *
293 * Check for errors
294 *
295 IF( NSIZES.LT.0 ) THEN
296 INFO = -1
297 ELSE IF( BADMM ) THEN
298 INFO = -2
299 ELSE IF( BADNN ) THEN
300 INFO = -3
301 ELSE IF( NTYPES.LT.0 ) THEN
302 INFO = -4
303 ELSE IF( LDA.LT.MAX( 1, MMAX ) ) THEN
304 INFO = -10
305 ELSE IF( LDU.LT.MAX( 1, MMAX ) ) THEN
306 INFO = -12
307 ELSE IF( LDVT.LT.MAX( 1, NMAX ) ) THEN
308 INFO = -14
309 ELSE IF( MINWRK.GT.LWORK ) THEN
310 INFO = -21
311 END IF
312 *
313 IF( INFO.NE.0 ) THEN
314 CALL XERBLA( 'DDRVBD', -INFO )
315 RETURN
316 END IF
317 *
318 * Initialize constants
319 *
320 PATH( 1: 1 ) = 'Double precision'
321 PATH( 2: 3 ) = 'BD'
322 NFAIL = 0
323 NTEST = 0
324 UNFL = DLAMCH( 'Safe minimum' )
325 OVFL = ONE / UNFL
326 CALL DLABAD( UNFL, OVFL )
327 ULP = DLAMCH( 'Precision' )
328 ULPINV = ONE / ULP
329 INFOT = 0
330 *
331 * Loop over sizes, types
332 *
333 DO 150 JSIZE = 1, NSIZES
334 M = MM( JSIZE )
335 N = NN( JSIZE )
336 MNMIN = MIN( M, N )
337 *
338 IF( NSIZES.NE.1 ) THEN
339 MTYPES = MIN( MAXTYP, NTYPES )
340 ELSE
341 MTYPES = MIN( MAXTYP+1, NTYPES )
342 END IF
343 *
344 DO 140 JTYPE = 1, MTYPES
345 IF( .NOT.DOTYPE( JTYPE ) )
346 $ GO TO 140
347 *
348 DO 20 J = 1, 4
349 IOLDSD( J ) = ISEED( J )
350 20 CONTINUE
351 *
352 * Compute "A"
353 *
354 IF( MTYPES.GT.MAXTYP )
355 $ GO TO 30
356 *
357 IF( JTYPE.EQ.1 ) THEN
358 *
359 * Zero matrix
360 *
361 CALL DLASET( 'Full', M, N, ZERO, ZERO, A, LDA )
362 *
363 ELSE IF( JTYPE.EQ.2 ) THEN
364 *
365 * Identity matrix
366 *
367 CALL DLASET( 'Full', M, N, ZERO, ONE, A, LDA )
368 *
369 ELSE
370 *
371 * (Scaled) random matrix
372 *
373 IF( JTYPE.EQ.3 )
374 $ ANORM = ONE
375 IF( JTYPE.EQ.4 )
376 $ ANORM = UNFL / ULP
377 IF( JTYPE.EQ.5 )
378 $ ANORM = OVFL*ULP
379 CALL DLATMS( M, N, 'U', ISEED, 'N', S, 4, DBLE( MNMIN ),
380 $ ANORM, M-1, N-1, 'N', A, LDA, WORK, IINFO )
381 IF( IINFO.NE.0 ) THEN
382 WRITE( NOUT, FMT = 9996 )'Generator', IINFO, M, N,
383 $ JTYPE, IOLDSD
384 INFO = ABS( IINFO )
385 RETURN
386 END IF
387 END IF
388 *
389 30 CONTINUE
390 CALL DLACPY( 'F', M, N, A, LDA, ASAV, LDA )
391 *
392 * Do for minimal and adequate (for blocking) workspace
393 *
394 DO 130 IWS = 1, 4
395 *
396 DO 40 J = 1, 14
397 RESULT( J ) = -ONE
398 40 CONTINUE
399 *
400 * Test DGESVD: Factorize A
401 *
402 IWTMP = MAX( 3*MIN( M, N )+MAX( M, N ), 5*MIN( M, N ) )
403 LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
404 LSWORK = MIN( LSWORK, LWORK )
405 LSWORK = MAX( LSWORK, 1 )
406 IF( IWS.EQ.4 )
407 $ LSWORK = LWORK
408 *
409 IF( IWS.GT.1 )
410 $ CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA )
411 SRNAMT = 'DGESVD'
412 CALL DGESVD( 'A', 'A', M, N, A, LDA, SSAV, USAV, LDU,
413 $ VTSAV, LDVT, WORK, LSWORK, IINFO )
414 IF( IINFO.NE.0 ) THEN
415 WRITE( NOUT, FMT = 9995 )'GESVD', IINFO, M, N, JTYPE,
416 $ LSWORK, IOLDSD
417 INFO = ABS( IINFO )
418 RETURN
419 END IF
420 *
421 * Do tests 1--4
422 *
423 CALL DBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
424 $ VTSAV, LDVT, WORK, RESULT( 1 ) )
425 IF( M.NE.0 .AND. N.NE.0 ) THEN
426 CALL DORT01( 'Columns', M, M, USAV, LDU, WORK, LWORK,
427 $ RESULT( 2 ) )
428 CALL DORT01( 'Rows', N, N, VTSAV, LDVT, WORK, LWORK,
429 $ RESULT( 3 ) )
430 END IF
431 RESULT( 4 ) = ZERO
432 DO 50 I = 1, MNMIN - 1
433 IF( SSAV( I ).LT.SSAV( I+1 ) )
434 $ RESULT( 4 ) = ULPINV
435 IF( SSAV( I ).LT.ZERO )
436 $ RESULT( 4 ) = ULPINV
437 50 CONTINUE
438 IF( MNMIN.GE.1 ) THEN
439 IF( SSAV( MNMIN ).LT.ZERO )
440 $ RESULT( 4 ) = ULPINV
441 END IF
442 *
443 * Do partial SVDs, comparing to SSAV, USAV, and VTSAV
444 *
445 RESULT( 5 ) = ZERO
446 RESULT( 6 ) = ZERO
447 RESULT( 7 ) = ZERO
448 DO 80 IJU = 0, 3
449 DO 70 IJVT = 0, 3
450 IF( ( IJU.EQ.3 .AND. IJVT.EQ.3 ) .OR.
451 $ ( IJU.EQ.1 .AND. IJVT.EQ.1 ) )GO TO 70
452 JOBU = CJOB( IJU+1 )
453 JOBVT = CJOB( IJVT+1 )
454 CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA )
455 SRNAMT = 'DGESVD'
456 CALL DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU,
457 $ VT, LDVT, WORK, LSWORK, IINFO )
458 *
459 * Compare U
460 *
461 DIF = ZERO
462 IF( M.GT.0 .AND. N.GT.0 ) THEN
463 IF( IJU.EQ.1 ) THEN
464 CALL DORT03( 'C', M, MNMIN, M, MNMIN, USAV,
465 $ LDU, A, LDA, WORK, LWORK, DIF,
466 $ IINFO )
467 ELSE IF( IJU.EQ.2 ) THEN
468 CALL DORT03( 'C', M, MNMIN, M, MNMIN, USAV,
469 $ LDU, U, LDU, WORK, LWORK, DIF,
470 $ IINFO )
471 ELSE IF( IJU.EQ.3 ) THEN
472 CALL DORT03( 'C', M, M, M, MNMIN, USAV, LDU,
473 $ U, LDU, WORK, LWORK, DIF,
474 $ IINFO )
475 END IF
476 END IF
477 RESULT( 5 ) = MAX( RESULT( 5 ), DIF )
478 *
479 * Compare VT
480 *
481 DIF = ZERO
482 IF( M.GT.0 .AND. N.GT.0 ) THEN
483 IF( IJVT.EQ.1 ) THEN
484 CALL DORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
485 $ LDVT, A, LDA, WORK, LWORK, DIF,
486 $ IINFO )
487 ELSE IF( IJVT.EQ.2 ) THEN
488 CALL DORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
489 $ LDVT, VT, LDVT, WORK, LWORK,
490 $ DIF, IINFO )
491 ELSE IF( IJVT.EQ.3 ) THEN
492 CALL DORT03( 'R', N, N, N, MNMIN, VTSAV,
493 $ LDVT, VT, LDVT, WORK, LWORK,
494 $ DIF, IINFO )
495 END IF
496 END IF
497 RESULT( 6 ) = MAX( RESULT( 6 ), DIF )
498 *
499 * Compare S
500 *
501 DIF = ZERO
502 DIV = MAX( DBLE( MNMIN )*ULP*S( 1 ), UNFL )
503 DO 60 I = 1, MNMIN - 1
504 IF( SSAV( I ).LT.SSAV( I+1 ) )
505 $ DIF = ULPINV
506 IF( SSAV( I ).LT.ZERO )
507 $ DIF = ULPINV
508 DIF = MAX( DIF, ABS( SSAV( I )-S( I ) ) / DIV )
509 60 CONTINUE
510 RESULT( 7 ) = MAX( RESULT( 7 ), DIF )
511 70 CONTINUE
512 80 CONTINUE
513 *
514 * Test DGESDD: Factorize A
515 *
516 IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N )
517 LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
518 LSWORK = MIN( LSWORK, LWORK )
519 LSWORK = MAX( LSWORK, 1 )
520 IF( IWS.EQ.4 )
521 $ LSWORK = LWORK
522 *
523 CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA )
524 SRNAMT = 'DGESDD'
525 CALL DGESDD( 'A', M, N, A, LDA, SSAV, USAV, LDU, VTSAV,
526 $ LDVT, WORK, LSWORK, IWORK, IINFO )
527 IF( IINFO.NE.0 ) THEN
528 WRITE( NOUT, FMT = 9995 )'GESDD', IINFO, M, N, JTYPE,
529 $ LSWORK, IOLDSD
530 INFO = ABS( IINFO )
531 RETURN
532 END IF
533 *
534 * Do tests 8--11
535 *
536 CALL DBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
537 $ VTSAV, LDVT, WORK, RESULT( 8 ) )
538 IF( M.NE.0 .AND. N.NE.0 ) THEN
539 CALL DORT01( 'Columns', M, M, USAV, LDU, WORK, LWORK,
540 $ RESULT( 9 ) )
541 CALL DORT01( 'Rows', N, N, VTSAV, LDVT, WORK, LWORK,
542 $ RESULT( 10 ) )
543 END IF
544 RESULT( 11 ) = ZERO
545 DO 90 I = 1, MNMIN - 1
546 IF( SSAV( I ).LT.SSAV( I+1 ) )
547 $ RESULT( 11 ) = ULPINV
548 IF( SSAV( I ).LT.ZERO )
549 $ RESULT( 11 ) = ULPINV
550 90 CONTINUE
551 IF( MNMIN.GE.1 ) THEN
552 IF( SSAV( MNMIN ).LT.ZERO )
553 $ RESULT( 11 ) = ULPINV
554 END IF
555 *
556 * Do partial SVDs, comparing to SSAV, USAV, and VTSAV
557 *
558 RESULT( 12 ) = ZERO
559 RESULT( 13 ) = ZERO
560 RESULT( 14 ) = ZERO
561 DO 110 IJQ = 0, 2
562 JOBQ = CJOB( IJQ+1 )
563 CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA )
564 SRNAMT = 'DGESDD'
565 CALL DGESDD( JOBQ, M, N, A, LDA, S, U, LDU, VT, LDVT,
566 $ WORK, LSWORK, IWORK, IINFO )
567 *
568 * Compare U
569 *
570 DIF = ZERO
571 IF( M.GT.0 .AND. N.GT.0 ) THEN
572 IF( IJQ.EQ.1 ) THEN
573 IF( M.GE.N ) THEN
574 CALL DORT03( 'C', M, MNMIN, M, MNMIN, USAV,
575 $ LDU, A, LDA, WORK, LWORK, DIF,
576 $ INFO )
577 ELSE
578 CALL DORT03( 'C', M, MNMIN, M, MNMIN, USAV,
579 $ LDU, U, LDU, WORK, LWORK, DIF,
580 $ INFO )
581 END IF
582 ELSE IF( IJQ.EQ.2 ) THEN
583 CALL DORT03( 'C', M, MNMIN, M, MNMIN, USAV, LDU,
584 $ U, LDU, WORK, LWORK, DIF, INFO )
585 END IF
586 END IF
587 RESULT( 12 ) = MAX( RESULT( 12 ), DIF )
588 *
589 * Compare VT
590 *
591 DIF = ZERO
592 IF( M.GT.0 .AND. N.GT.0 ) THEN
593 IF( IJQ.EQ.1 ) THEN
594 IF( M.GE.N ) THEN
595 CALL DORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
596 $ LDVT, VT, LDVT, WORK, LWORK,
597 $ DIF, INFO )
598 ELSE
599 CALL DORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
600 $ LDVT, A, LDA, WORK, LWORK, DIF,
601 $ INFO )
602 END IF
603 ELSE IF( IJQ.EQ.2 ) THEN
604 CALL DORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
605 $ LDVT, VT, LDVT, WORK, LWORK, DIF,
606 $ INFO )
607 END IF
608 END IF
609 RESULT( 13 ) = MAX( RESULT( 13 ), DIF )
610 *
611 * Compare S
612 *
613 DIF = ZERO
614 DIV = MAX( DBLE( MNMIN )*ULP*S( 1 ), UNFL )
615 DO 100 I = 1, MNMIN - 1
616 IF( SSAV( I ).LT.SSAV( I+1 ) )
617 $ DIF = ULPINV
618 IF( SSAV( I ).LT.ZERO )
619 $ DIF = ULPINV
620 DIF = MAX( DIF, ABS( SSAV( I )-S( I ) ) / DIV )
621 100 CONTINUE
622 RESULT( 14 ) = MAX( RESULT( 14 ), DIF )
623 110 CONTINUE
624 *
625 * Test DGESVJ: Factorize A
626 * Note: DGESVJ does not work for M < N
627 *
628 RESULT( 15 ) = ZERO
629 RESULT( 16 ) = ZERO
630 RESULT( 17 ) = ZERO
631 RESULT( 18 ) = ZERO
632 *
633 IF( M.GE.N ) THEN
634 IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N )
635 LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
636 LSWORK = MIN( LSWORK, LWORK )
637 LSWORK = MAX( LSWORK, 1 )
638 IF( IWS.EQ.4 )
639 $ LSWORK = LWORK
640 *
641 CALL DLACPY( 'F', M, N, ASAV, LDA, USAV, LDA )
642 SRNAMT = 'DGESVJ'
643 CALL DGESVJ( 'G', 'U', 'V', M, N, USAV, LDA, SSAV,
644 & 0, A, LDVT, WORK, LWORK, INFO )
645 *
646 * DGESVJ retuns V not VT, so we transpose to use the same
647 * test suite.
648 *
649 DO J=1,N
650 DO I=1,N
651 VTSAV(J,I) = A(I,J)
652 END DO
653 END DO
654 *
655 IF( IINFO.NE.0 ) THEN
656 WRITE( NOUT, FMT = 9995 )'GESVJ', IINFO, M, N,
657 $ JTYPE, LSWORK, IOLDSD
658 INFO = ABS( IINFO )
659 RETURN
660 END IF
661 *
662 * Do tests 15--18
663 *
664 CALL DBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
665 $ VTSAV, LDVT, WORK, RESULT( 15 ) )
666 IF( M.NE.0 .AND. N.NE.0 ) THEN
667 CALL DORT01( 'Columns', M, M, USAV, LDU, WORK,
668 $ LWORK, RESULT( 16 ) )
669 CALL DORT01( 'Rows', N, N, VTSAV, LDVT, WORK,
670 $ LWORK, RESULT( 17 ) )
671 END IF
672 RESULT( 18 ) = ZERO
673 DO 200 I = 1, MNMIN - 1
674 IF( SSAV( I ).LT.SSAV( I+1 ) )
675 $ RESULT( 18 ) = ULPINV
676 IF( SSAV( I ).LT.ZERO )
677 $ RESULT( 18 ) = ULPINV
678 200 CONTINUE
679 IF( MNMIN.GE.1 ) THEN
680 IF( SSAV( MNMIN ).LT.ZERO )
681 $ RESULT( 18 ) = ULPINV
682 END IF
683 END IF
684 *
685 * Test DGEJSV: Factorize A
686 * Note: DGEJSV does not work for M < N
687 *
688 RESULT( 19 ) = ZERO
689 RESULT( 20 ) = ZERO
690 RESULT( 21 ) = ZERO
691 RESULT( 22 ) = ZERO
692 IF( M.GE.N ) THEN
693 IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N )
694 LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
695 LSWORK = MIN( LSWORK, LWORK )
696 LSWORK = MAX( LSWORK, 1 )
697 IF( IWS.EQ.4 )
698 $ LSWORK = LWORK
699 *
700 CALL DLACPY( 'F', M, N, ASAV, LDA, VTSAV, LDA )
701 SRNAMT = 'DGEJSV'
702 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
703 & M, N, VTSAV, LDA, SSAV, USAV, LDU, A, LDVT,
704 & WORK, LWORK, IWORK, INFO )
705 *
706 * DGEJSV retuns V not VT, so we transpose to use the same
707 * test suite.
708 *
709 DO J=1,N
710 DO I=1,N
711 VTSAV(J,I) = A(I,J)
712 END DO
713 END DO
714 *
715 IF( IINFO.NE.0 ) THEN
716 WRITE( NOUT, FMT = 9995 )'GESVJ', IINFO, M, N,
717 $ JTYPE, LSWORK, IOLDSD
718 INFO = ABS( IINFO )
719 RETURN
720 END IF
721 *
722 * Do tests 19--22
723 *
724 CALL DBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
725 $ VTSAV, LDVT, WORK, RESULT( 19 ) )
726 IF( M.NE.0 .AND. N.NE.0 ) THEN
727 CALL DORT01( 'Columns', M, M, USAV, LDU, WORK,
728 $ LWORK, RESULT( 20 ) )
729 CALL DORT01( 'Rows', N, N, VTSAV, LDVT, WORK,
730 $ LWORK, RESULT( 21 ) )
731 END IF
732 RESULT( 22 ) = ZERO
733 DO 300 I = 1, MNMIN - 1
734 IF( SSAV( I ).LT.SSAV( I+1 ) )
735 $ RESULT( 22 ) = ULPINV
736 IF( SSAV( I ).LT.ZERO )
737 $ RESULT( 22 ) = ULPINV
738 300 CONTINUE
739 IF( MNMIN.GE.1 ) THEN
740 IF( SSAV( MNMIN ).LT.ZERO )
741 $ RESULT( 22 ) = ULPINV
742 END IF
743 END IF
744 *
745 * End of Loop -- Check for RESULT(j) > THRESH
746 *
747 DO 120 J = 1, 22
748 IF( RESULT( J ).GE.THRESH ) THEN
749 IF( NFAIL.EQ.0 ) THEN
750 WRITE( NOUT, FMT = 9999 )
751 WRITE( NOUT, FMT = 9998 )
752 END IF
753 WRITE( NOUT, FMT = 9997 )M, N, JTYPE, IWS, IOLDSD,
754 $ J, RESULT( J )
755 NFAIL = NFAIL + 1
756 END IF
757 120 CONTINUE
758 NTEST = NTEST + 22
759 *
760 130 CONTINUE
761 140 CONTINUE
762 150 CONTINUE
763 *
764 * Summary
765 *
766 CALL ALASVM( PATH, NOUT, NFAIL, NTEST, 0 )
767 *
768 9999 FORMAT( ' SVD -- Real Singular Value Decomposition Driver ',
769 $ / ' Matrix types (see DDRVBD for details):',
770 $ / / ' 1 = Zero matrix', / ' 2 = Identity matrix',
771 $ / ' 3 = Evenly spaced singular values near 1',
772 $ / ' 4 = Evenly spaced singular values near underflow',
773 $ / ' 5 = Evenly spaced singular values near overflow', / /
774 $ ' Tests performed: ( A is dense, U and V are orthogonal,',
775 $ / 19X, ' S is an array, and Upartial, VTpartial, and',
776 $ / 19X, ' Spartial are partially computed U, VT and S),', / )
777 9998 FORMAT( ' 1 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
778 $ / ' 2 = | I - U**T U | / ( M ulp ) ',
779 $ / ' 3 = | I - VT VT**T | / ( N ulp ) ',
780 $ / ' 4 = 0 if S contains min(M,N) nonnegative values in',
781 $ ' decreasing order, else 1/ulp',
782 $ / ' 5 = | U - Upartial | / ( M ulp )',
783 $ / ' 6 = | VT - VTpartial | / ( N ulp )',
784 $ / ' 7 = | S - Spartial | / ( min(M,N) ulp |S| )',
785 $ / ' 8 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
786 $ / ' 9 = | I - U**T U | / ( M ulp ) ',
787 $ / '10 = | I - VT VT**T | / ( N ulp ) ',
788 $ / '11 = 0 if S contains min(M,N) nonnegative values in',
789 $ ' decreasing order, else 1/ulp',
790 $ / '12 = | U - Upartial | / ( M ulp )',
791 $ / '13 = | VT - VTpartial | / ( N ulp )',
792 $ / '14 = | S - Spartial | / ( min(M,N) ulp |S| )',
793 $ / '15 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
794 $ / '16 = | I - U**T U | / ( M ulp ) ',
795 $ / '17 = | I - VT VT**T | / ( N ulp ) ',
796 $ / '18 = 0 if S contains min(M,N) nonnegative values in',
797 $ ' decreasing order, else 1/ulp',
798 $ / '19 = | U - Upartial | / ( M ulp )',
799 $ / '20 = | VT - VTpartial | / ( N ulp )',
800 $ / '21 = | S - Spartial | / ( min(M,N) ulp |S| )', / / )
801 9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1,
802 $ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 )
803 9996 FORMAT( ' DDRVBD: ', A, ' returned INFO=', I6, '.', / 9X, 'M=',
804 $ I6, ', N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ),
805 $ I5, ')' )
806 9995 FORMAT( ' DDRVBD: ', A, ' returned INFO=', I6, '.', / 9X, 'M=',
807 $ I6, ', N=', I6, ', JTYPE=', I6, ', LSWORK=', I6, / 9X,
808 $ 'ISEED=(', 3( I5, ',' ), I5, ')' )
809 *
810 RETURN
811 *
812 * End of DDRVBD
813 *
814 END
2 $ A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S,
3 $ SSAV, E, WORK, LWORK, IWORK, NOUT, INFO )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES,
11 $ NTYPES
12 DOUBLE PRECISION THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
17 DOUBLE PRECISION A( LDA, * ), ASAV( LDA, * ), E( * ), S( * ),
18 $ SSAV( * ), U( LDU, * ), USAV( LDU, * ),
19 $ VT( LDVT, * ), VTSAV( LDVT, * ), WORK( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * DDRVBD checks the singular value decomposition (SVD) drivers
26 * DGESVD, DGESDD, DGESVJ, and DGEJSV.
27 *
28 * Both DGESVD and DGESDD factor A = U diag(S) VT, where U and VT are
29 * orthogonal and diag(S) is diagonal with the entries of the array S
30 * on its diagonal. The entries of S are the singular values,
31 * nonnegative and stored in decreasing order. U and VT can be
32 * optionally not computed, overwritten on A, or computed partially.
33 *
34 * A is M by N. Let MNMIN = min( M, N ). S has dimension MNMIN.
35 * U can be M by M or M by MNMIN. VT can be N by N or MNMIN by N.
36 *
37 * When DDRVBD is called, a number of matrix "sizes" (M's and N's)
38 * and a number of matrix "types" are specified. For each size (M,N)
39 * and each type of matrix, and for the minimal workspace as well as
40 * workspace adequate to permit blocking, an M x N matrix "A" will be
41 * generated and used to test the SVD routines. For each matrix, A will
42 * be factored as A = U diag(S) VT and the following 12 tests computed:
43 *
44 * Test for DGESVD:
45 *
46 * (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
47 *
48 * (2) | I - U'U | / ( M ulp )
49 *
50 * (3) | I - VT VT' | / ( N ulp )
51 *
52 * (4) S contains MNMIN nonnegative values in decreasing order.
53 * (Return 0 if true, 1/ULP if false.)
54 *
55 * (5) | U - Upartial | / ( M ulp ) where Upartial is a partially
56 * computed U.
57 *
58 * (6) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
59 * computed VT.
60 *
61 * (7) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
62 * vector of singular values from the partial SVD
63 *
64 * Test for DGESDD:
65 *
66 * (8) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
67 *
68 * (9) | I - U'U | / ( M ulp )
69 *
70 * (10) | I - VT VT' | / ( N ulp )
71 *
72 * (11) S contains MNMIN nonnegative values in decreasing order.
73 * (Return 0 if true, 1/ULP if false.)
74 *
75 * (12) | U - Upartial | / ( M ulp ) where Upartial is a partially
76 * computed U.
77 *
78 * (13) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
79 * computed VT.
80 *
81 * (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
82 * vector of singular values from the partial SVD
83 *
84 * Test for SGESVJ:
85 *
86 * (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
87 *
88 * (16) | I - U'U | / ( M ulp )
89 *
90 * (17) | I - VT VT' | / ( N ulp )
91 *
92 * (18) S contains MNMIN nonnegative values in decreasing order.
93 * (Return 0 if true, 1/ULP if false.)
94 *
95 * Test for SGEJSV:
96 *
97 * (19) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
98 *
99 * (20) | I - U'U | / ( M ulp )
100 *
101 * (21) | I - VT VT' | / ( N ulp )
102 *
103 * (22) S contains MNMIN nonnegative values in decreasing order.
104 * (Return 0 if true, 1/ULP if false.)
105 *
106 * The "sizes" are specified by the arrays MM(1:NSIZES) and
107 * NN(1:NSIZES); the value of each element pair (MM(j),NN(j))
108 * specifies one size. The "types" are specified by a logical array
109 * DOTYPE( 1:NTYPES ); if DOTYPE(j) is .TRUE., then matrix type "j"
110 * will be generated.
111 * Currently, the list of possible types is:
112 *
113 * (1) The zero matrix.
114 * (2) The identity matrix.
115 * (3) A matrix of the form U D V, where U and V are orthogonal and
116 * D has evenly spaced entries 1, ..., ULP with random signs
117 * on the diagonal.
118 * (4) Same as (3), but multiplied by the underflow-threshold / ULP.
119 * (5) Same as (3), but multiplied by the overflow-threshold * ULP.
120 *
121 * Arguments
122 * ==========
123 *
124 * NSIZES (input) INTEGER
125 * The number of matrix sizes (M,N) contained in the vectors
126 * MM and NN.
127 *
128 * MM (input) INTEGER array, dimension (NSIZES)
129 * The values of the matrix row dimension M.
130 *
131 * NN (input) INTEGER array, dimension (NSIZES)
132 * The values of the matrix column dimension N.
133 *
134 * NTYPES (input) INTEGER
135 * The number of elements in DOTYPE. If it is zero, DDRVBD
136 * does nothing. It must be at least zero. If it is MAXTYP+1
137 * and NSIZES is 1, then an additional type, MAXTYP+1 is
138 * defined, which is to use whatever matrices are in A and B.
139 * This is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
140 * DOTYPE(MAXTYP+1) is .TRUE. .
141 *
142 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
143 * If DOTYPE(j) is .TRUE., then for each size (m,n), a matrix
144 * of type j will be generated. If NTYPES is smaller than the
145 * maximum number of types defined (PARAMETER MAXTYP), then
146 * types NTYPES+1 through MAXTYP will not be generated. If
147 * NTYPES is larger than MAXTYP, DOTYPE(MAXTYP+1) through
148 * DOTYPE(NTYPES) will be ignored.
149 *
150 * ISEED (input/output) INTEGER array, dimension (4)
151 * On entry, the seed of the random number generator. The array
152 * elements should be between 0 and 4095; if not they will be
153 * reduced mod 4096. Also, ISEED(4) must be odd.
154 * On exit, ISEED is changed and can be used in the next call to
155 * DDRVBD to continue the same random number sequence.
156 *
157 * THRESH (input) DOUBLE PRECISION
158 * The threshold value for the test ratios. A result is
159 * included in the output file if RESULT >= THRESH. The test
160 * ratios are scaled to be O(1), so THRESH should be a small
161 * multiple of 1, e.g., 10 or 100. To have every test ratio
162 * printed, use THRESH = 0.
163 *
164 * A (workspace) DOUBLE PRECISION array, dimension (LDA,NMAX)
165 * where NMAX is the maximum value of N in NN.
166 *
167 * LDA (input) INTEGER
168 * The leading dimension of the array A. LDA >= max(1,MMAX),
169 * where MMAX is the maximum value of M in MM.
170 *
171 * U (workspace) DOUBLE PRECISION array, dimension (LDU,MMAX)
172 *
173 * LDU (input) INTEGER
174 * The leading dimension of the array U. LDU >= max(1,MMAX).
175 *
176 * VT (workspace) DOUBLE PRECISION array, dimension (LDVT,NMAX)
177 *
178 * LDVT (input) INTEGER
179 * The leading dimension of the array VT. LDVT >= max(1,NMAX).
180 *
181 * ASAV (workspace) DOUBLE PRECISION array, dimension (LDA,NMAX)
182 *
183 * USAV (workspace) DOUBLE PRECISION array, dimension (LDU,MMAX)
184 *
185 * VTSAV (workspace) DOUBLE PRECISION array, dimension (LDVT,NMAX)
186 *
187 * S (workspace) DOUBLE PRECISION array, dimension
188 * (max(min(MM,NN)))
189 *
190 * SSAV (workspace) DOUBLE PRECISION array, dimension
191 * (max(min(MM,NN)))
192 *
193 * E (workspace) DOUBLE PRECISION array, dimension
194 * (max(min(MM,NN)))
195 *
196 * WORK (workspace) DOUBLE PRECISION array, dimension (LWORK)
197 *
198 * LWORK (input) INTEGER
199 * The number of entries in WORK. This must be at least
200 * max(3*MN+MX,5*MN-4)+2*MN**2 for all pairs
201 * pairs (MN,MX)=( min(MM(j),NN(j), max(MM(j),NN(j)) )
202 *
203 * IWORK (workspace) INTEGER array, dimension at least 8*min(M,N)
204 *
205 * NOUT (input) INTEGER
206 * The FORTRAN unit number for printing out error messages
207 * (e.g., if a routine returns IINFO not equal to 0.)
208 *
209 * INFO (output) INTEGER
210 * If 0, then everything ran OK.
211 * -1: NSIZES < 0
212 * -2: Some MM(j) < 0
213 * -3: Some NN(j) < 0
214 * -4: NTYPES < 0
215 * -7: THRESH < 0
216 * -10: LDA < 1 or LDA < MMAX, where MMAX is max( MM(j) ).
217 * -12: LDU < 1 or LDU < MMAX.
218 * -14: LDVT < 1 or LDVT < NMAX, where NMAX is max( NN(j) ).
219 * -21: LWORK too small.
220 * If DLATMS, or DGESVD returns an error code, the
221 * absolute value of it is returned.
222 *
223 * =====================================================================
224 *
225 * .. Parameters ..
226 DOUBLE PRECISION ZERO, ONE
227 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
228 INTEGER MAXTYP
229 PARAMETER ( MAXTYP = 5 )
230 * ..
231 * .. Local Scalars ..
232 LOGICAL BADMM, BADNN
233 CHARACTER JOBQ, JOBU, JOBVT
234 CHARACTER*3 PATH
235 INTEGER I, IINFO, IJQ, IJU, IJVT, IWS, IWTMP, J, JSIZE,
236 $ JTYPE, LSWORK, M, MINWRK, MMAX, MNMAX, MNMIN,
237 $ MTYPES, N, NFAIL, NMAX, NTEST
238 DOUBLE PRECISION ANORM, DIF, DIV, OVFL, ULP, ULPINV, UNFL
239 * ..
240 * .. Local Arrays ..
241 CHARACTER CJOB( 4 )
242 INTEGER IOLDSD( 4 )
243 DOUBLE PRECISION RESULT( 22 )
244 * ..
245 * .. External Functions ..
246 DOUBLE PRECISION DLAMCH
247 EXTERNAL DLAMCH
248 * ..
249 * .. External Subroutines ..
250 EXTERNAL ALASVM, DBDT01, DGESDD, DGESVD, DLABAD, DLACPY,
251 $ DLASET, DLATMS, DORT01, DORT03, XERBLA, DGESVJ,
252 $ DGEJSV
253 * ..
254 * .. Intrinsic Functions ..
255 INTRINSIC ABS, DBLE, MAX, MIN
256 * ..
257 * .. Scalars in Common ..
258 LOGICAL LERR, OK
259 CHARACTER*32 SRNAMT
260 INTEGER INFOT, NUNIT
261 * ..
262 * .. Common blocks ..
263 COMMON / INFOC / INFOT, NUNIT, OK, LERR
264 COMMON / SRNAMC / SRNAMT
265 * ..
266 * .. Data statements ..
267 DATA CJOB / 'N', 'O', 'S', 'A' /
268 * ..
269 * .. Executable Statements ..
270 *
271 * Check for errors
272 *
273 INFO = 0
274 BADMM = .FALSE.
275 BADNN = .FALSE.
276 MMAX = 1
277 NMAX = 1
278 MNMAX = 1
279 MINWRK = 1
280 DO 10 J = 1, NSIZES
281 MMAX = MAX( MMAX, MM( J ) )
282 IF( MM( J ).LT.0 )
283 $ BADMM = .TRUE.
284 NMAX = MAX( NMAX, NN( J ) )
285 IF( NN( J ).LT.0 )
286 $ BADNN = .TRUE.
287 MNMAX = MAX( MNMAX, MIN( MM( J ), NN( J ) ) )
288 MINWRK = MAX( MINWRK, MAX( 3*MIN( MM( J ),
289 $ NN( J ) )+MAX( MM( J ), NN( J ) ), 5*MIN( MM( J ),
290 $ NN( J )-4 ) )+2*MIN( MM( J ), NN( J ) )**2 )
291 10 CONTINUE
292 *
293 * Check for errors
294 *
295 IF( NSIZES.LT.0 ) THEN
296 INFO = -1
297 ELSE IF( BADMM ) THEN
298 INFO = -2
299 ELSE IF( BADNN ) THEN
300 INFO = -3
301 ELSE IF( NTYPES.LT.0 ) THEN
302 INFO = -4
303 ELSE IF( LDA.LT.MAX( 1, MMAX ) ) THEN
304 INFO = -10
305 ELSE IF( LDU.LT.MAX( 1, MMAX ) ) THEN
306 INFO = -12
307 ELSE IF( LDVT.LT.MAX( 1, NMAX ) ) THEN
308 INFO = -14
309 ELSE IF( MINWRK.GT.LWORK ) THEN
310 INFO = -21
311 END IF
312 *
313 IF( INFO.NE.0 ) THEN
314 CALL XERBLA( 'DDRVBD', -INFO )
315 RETURN
316 END IF
317 *
318 * Initialize constants
319 *
320 PATH( 1: 1 ) = 'Double precision'
321 PATH( 2: 3 ) = 'BD'
322 NFAIL = 0
323 NTEST = 0
324 UNFL = DLAMCH( 'Safe minimum' )
325 OVFL = ONE / UNFL
326 CALL DLABAD( UNFL, OVFL )
327 ULP = DLAMCH( 'Precision' )
328 ULPINV = ONE / ULP
329 INFOT = 0
330 *
331 * Loop over sizes, types
332 *
333 DO 150 JSIZE = 1, NSIZES
334 M = MM( JSIZE )
335 N = NN( JSIZE )
336 MNMIN = MIN( M, N )
337 *
338 IF( NSIZES.NE.1 ) THEN
339 MTYPES = MIN( MAXTYP, NTYPES )
340 ELSE
341 MTYPES = MIN( MAXTYP+1, NTYPES )
342 END IF
343 *
344 DO 140 JTYPE = 1, MTYPES
345 IF( .NOT.DOTYPE( JTYPE ) )
346 $ GO TO 140
347 *
348 DO 20 J = 1, 4
349 IOLDSD( J ) = ISEED( J )
350 20 CONTINUE
351 *
352 * Compute "A"
353 *
354 IF( MTYPES.GT.MAXTYP )
355 $ GO TO 30
356 *
357 IF( JTYPE.EQ.1 ) THEN
358 *
359 * Zero matrix
360 *
361 CALL DLASET( 'Full', M, N, ZERO, ZERO, A, LDA )
362 *
363 ELSE IF( JTYPE.EQ.2 ) THEN
364 *
365 * Identity matrix
366 *
367 CALL DLASET( 'Full', M, N, ZERO, ONE, A, LDA )
368 *
369 ELSE
370 *
371 * (Scaled) random matrix
372 *
373 IF( JTYPE.EQ.3 )
374 $ ANORM = ONE
375 IF( JTYPE.EQ.4 )
376 $ ANORM = UNFL / ULP
377 IF( JTYPE.EQ.5 )
378 $ ANORM = OVFL*ULP
379 CALL DLATMS( M, N, 'U', ISEED, 'N', S, 4, DBLE( MNMIN ),
380 $ ANORM, M-1, N-1, 'N', A, LDA, WORK, IINFO )
381 IF( IINFO.NE.0 ) THEN
382 WRITE( NOUT, FMT = 9996 )'Generator', IINFO, M, N,
383 $ JTYPE, IOLDSD
384 INFO = ABS( IINFO )
385 RETURN
386 END IF
387 END IF
388 *
389 30 CONTINUE
390 CALL DLACPY( 'F', M, N, A, LDA, ASAV, LDA )
391 *
392 * Do for minimal and adequate (for blocking) workspace
393 *
394 DO 130 IWS = 1, 4
395 *
396 DO 40 J = 1, 14
397 RESULT( J ) = -ONE
398 40 CONTINUE
399 *
400 * Test DGESVD: Factorize A
401 *
402 IWTMP = MAX( 3*MIN( M, N )+MAX( M, N ), 5*MIN( M, N ) )
403 LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
404 LSWORK = MIN( LSWORK, LWORK )
405 LSWORK = MAX( LSWORK, 1 )
406 IF( IWS.EQ.4 )
407 $ LSWORK = LWORK
408 *
409 IF( IWS.GT.1 )
410 $ CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA )
411 SRNAMT = 'DGESVD'
412 CALL DGESVD( 'A', 'A', M, N, A, LDA, SSAV, USAV, LDU,
413 $ VTSAV, LDVT, WORK, LSWORK, IINFO )
414 IF( IINFO.NE.0 ) THEN
415 WRITE( NOUT, FMT = 9995 )'GESVD', IINFO, M, N, JTYPE,
416 $ LSWORK, IOLDSD
417 INFO = ABS( IINFO )
418 RETURN
419 END IF
420 *
421 * Do tests 1--4
422 *
423 CALL DBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
424 $ VTSAV, LDVT, WORK, RESULT( 1 ) )
425 IF( M.NE.0 .AND. N.NE.0 ) THEN
426 CALL DORT01( 'Columns', M, M, USAV, LDU, WORK, LWORK,
427 $ RESULT( 2 ) )
428 CALL DORT01( 'Rows', N, N, VTSAV, LDVT, WORK, LWORK,
429 $ RESULT( 3 ) )
430 END IF
431 RESULT( 4 ) = ZERO
432 DO 50 I = 1, MNMIN - 1
433 IF( SSAV( I ).LT.SSAV( I+1 ) )
434 $ RESULT( 4 ) = ULPINV
435 IF( SSAV( I ).LT.ZERO )
436 $ RESULT( 4 ) = ULPINV
437 50 CONTINUE
438 IF( MNMIN.GE.1 ) THEN
439 IF( SSAV( MNMIN ).LT.ZERO )
440 $ RESULT( 4 ) = ULPINV
441 END IF
442 *
443 * Do partial SVDs, comparing to SSAV, USAV, and VTSAV
444 *
445 RESULT( 5 ) = ZERO
446 RESULT( 6 ) = ZERO
447 RESULT( 7 ) = ZERO
448 DO 80 IJU = 0, 3
449 DO 70 IJVT = 0, 3
450 IF( ( IJU.EQ.3 .AND. IJVT.EQ.3 ) .OR.
451 $ ( IJU.EQ.1 .AND. IJVT.EQ.1 ) )GO TO 70
452 JOBU = CJOB( IJU+1 )
453 JOBVT = CJOB( IJVT+1 )
454 CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA )
455 SRNAMT = 'DGESVD'
456 CALL DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU,
457 $ VT, LDVT, WORK, LSWORK, IINFO )
458 *
459 * Compare U
460 *
461 DIF = ZERO
462 IF( M.GT.0 .AND. N.GT.0 ) THEN
463 IF( IJU.EQ.1 ) THEN
464 CALL DORT03( 'C', M, MNMIN, M, MNMIN, USAV,
465 $ LDU, A, LDA, WORK, LWORK, DIF,
466 $ IINFO )
467 ELSE IF( IJU.EQ.2 ) THEN
468 CALL DORT03( 'C', M, MNMIN, M, MNMIN, USAV,
469 $ LDU, U, LDU, WORK, LWORK, DIF,
470 $ IINFO )
471 ELSE IF( IJU.EQ.3 ) THEN
472 CALL DORT03( 'C', M, M, M, MNMIN, USAV, LDU,
473 $ U, LDU, WORK, LWORK, DIF,
474 $ IINFO )
475 END IF
476 END IF
477 RESULT( 5 ) = MAX( RESULT( 5 ), DIF )
478 *
479 * Compare VT
480 *
481 DIF = ZERO
482 IF( M.GT.0 .AND. N.GT.0 ) THEN
483 IF( IJVT.EQ.1 ) THEN
484 CALL DORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
485 $ LDVT, A, LDA, WORK, LWORK, DIF,
486 $ IINFO )
487 ELSE IF( IJVT.EQ.2 ) THEN
488 CALL DORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
489 $ LDVT, VT, LDVT, WORK, LWORK,
490 $ DIF, IINFO )
491 ELSE IF( IJVT.EQ.3 ) THEN
492 CALL DORT03( 'R', N, N, N, MNMIN, VTSAV,
493 $ LDVT, VT, LDVT, WORK, LWORK,
494 $ DIF, IINFO )
495 END IF
496 END IF
497 RESULT( 6 ) = MAX( RESULT( 6 ), DIF )
498 *
499 * Compare S
500 *
501 DIF = ZERO
502 DIV = MAX( DBLE( MNMIN )*ULP*S( 1 ), UNFL )
503 DO 60 I = 1, MNMIN - 1
504 IF( SSAV( I ).LT.SSAV( I+1 ) )
505 $ DIF = ULPINV
506 IF( SSAV( I ).LT.ZERO )
507 $ DIF = ULPINV
508 DIF = MAX( DIF, ABS( SSAV( I )-S( I ) ) / DIV )
509 60 CONTINUE
510 RESULT( 7 ) = MAX( RESULT( 7 ), DIF )
511 70 CONTINUE
512 80 CONTINUE
513 *
514 * Test DGESDD: Factorize A
515 *
516 IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N )
517 LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
518 LSWORK = MIN( LSWORK, LWORK )
519 LSWORK = MAX( LSWORK, 1 )
520 IF( IWS.EQ.4 )
521 $ LSWORK = LWORK
522 *
523 CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA )
524 SRNAMT = 'DGESDD'
525 CALL DGESDD( 'A', M, N, A, LDA, SSAV, USAV, LDU, VTSAV,
526 $ LDVT, WORK, LSWORK, IWORK, IINFO )
527 IF( IINFO.NE.0 ) THEN
528 WRITE( NOUT, FMT = 9995 )'GESDD', IINFO, M, N, JTYPE,
529 $ LSWORK, IOLDSD
530 INFO = ABS( IINFO )
531 RETURN
532 END IF
533 *
534 * Do tests 8--11
535 *
536 CALL DBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
537 $ VTSAV, LDVT, WORK, RESULT( 8 ) )
538 IF( M.NE.0 .AND. N.NE.0 ) THEN
539 CALL DORT01( 'Columns', M, M, USAV, LDU, WORK, LWORK,
540 $ RESULT( 9 ) )
541 CALL DORT01( 'Rows', N, N, VTSAV, LDVT, WORK, LWORK,
542 $ RESULT( 10 ) )
543 END IF
544 RESULT( 11 ) = ZERO
545 DO 90 I = 1, MNMIN - 1
546 IF( SSAV( I ).LT.SSAV( I+1 ) )
547 $ RESULT( 11 ) = ULPINV
548 IF( SSAV( I ).LT.ZERO )
549 $ RESULT( 11 ) = ULPINV
550 90 CONTINUE
551 IF( MNMIN.GE.1 ) THEN
552 IF( SSAV( MNMIN ).LT.ZERO )
553 $ RESULT( 11 ) = ULPINV
554 END IF
555 *
556 * Do partial SVDs, comparing to SSAV, USAV, and VTSAV
557 *
558 RESULT( 12 ) = ZERO
559 RESULT( 13 ) = ZERO
560 RESULT( 14 ) = ZERO
561 DO 110 IJQ = 0, 2
562 JOBQ = CJOB( IJQ+1 )
563 CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA )
564 SRNAMT = 'DGESDD'
565 CALL DGESDD( JOBQ, M, N, A, LDA, S, U, LDU, VT, LDVT,
566 $ WORK, LSWORK, IWORK, IINFO )
567 *
568 * Compare U
569 *
570 DIF = ZERO
571 IF( M.GT.0 .AND. N.GT.0 ) THEN
572 IF( IJQ.EQ.1 ) THEN
573 IF( M.GE.N ) THEN
574 CALL DORT03( 'C', M, MNMIN, M, MNMIN, USAV,
575 $ LDU, A, LDA, WORK, LWORK, DIF,
576 $ INFO )
577 ELSE
578 CALL DORT03( 'C', M, MNMIN, M, MNMIN, USAV,
579 $ LDU, U, LDU, WORK, LWORK, DIF,
580 $ INFO )
581 END IF
582 ELSE IF( IJQ.EQ.2 ) THEN
583 CALL DORT03( 'C', M, MNMIN, M, MNMIN, USAV, LDU,
584 $ U, LDU, WORK, LWORK, DIF, INFO )
585 END IF
586 END IF
587 RESULT( 12 ) = MAX( RESULT( 12 ), DIF )
588 *
589 * Compare VT
590 *
591 DIF = ZERO
592 IF( M.GT.0 .AND. N.GT.0 ) THEN
593 IF( IJQ.EQ.1 ) THEN
594 IF( M.GE.N ) THEN
595 CALL DORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
596 $ LDVT, VT, LDVT, WORK, LWORK,
597 $ DIF, INFO )
598 ELSE
599 CALL DORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
600 $ LDVT, A, LDA, WORK, LWORK, DIF,
601 $ INFO )
602 END IF
603 ELSE IF( IJQ.EQ.2 ) THEN
604 CALL DORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
605 $ LDVT, VT, LDVT, WORK, LWORK, DIF,
606 $ INFO )
607 END IF
608 END IF
609 RESULT( 13 ) = MAX( RESULT( 13 ), DIF )
610 *
611 * Compare S
612 *
613 DIF = ZERO
614 DIV = MAX( DBLE( MNMIN )*ULP*S( 1 ), UNFL )
615 DO 100 I = 1, MNMIN - 1
616 IF( SSAV( I ).LT.SSAV( I+1 ) )
617 $ DIF = ULPINV
618 IF( SSAV( I ).LT.ZERO )
619 $ DIF = ULPINV
620 DIF = MAX( DIF, ABS( SSAV( I )-S( I ) ) / DIV )
621 100 CONTINUE
622 RESULT( 14 ) = MAX( RESULT( 14 ), DIF )
623 110 CONTINUE
624 *
625 * Test DGESVJ: Factorize A
626 * Note: DGESVJ does not work for M < N
627 *
628 RESULT( 15 ) = ZERO
629 RESULT( 16 ) = ZERO
630 RESULT( 17 ) = ZERO
631 RESULT( 18 ) = ZERO
632 *
633 IF( M.GE.N ) THEN
634 IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N )
635 LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
636 LSWORK = MIN( LSWORK, LWORK )
637 LSWORK = MAX( LSWORK, 1 )
638 IF( IWS.EQ.4 )
639 $ LSWORK = LWORK
640 *
641 CALL DLACPY( 'F', M, N, ASAV, LDA, USAV, LDA )
642 SRNAMT = 'DGESVJ'
643 CALL DGESVJ( 'G', 'U', 'V', M, N, USAV, LDA, SSAV,
644 & 0, A, LDVT, WORK, LWORK, INFO )
645 *
646 * DGESVJ retuns V not VT, so we transpose to use the same
647 * test suite.
648 *
649 DO J=1,N
650 DO I=1,N
651 VTSAV(J,I) = A(I,J)
652 END DO
653 END DO
654 *
655 IF( IINFO.NE.0 ) THEN
656 WRITE( NOUT, FMT = 9995 )'GESVJ', IINFO, M, N,
657 $ JTYPE, LSWORK, IOLDSD
658 INFO = ABS( IINFO )
659 RETURN
660 END IF
661 *
662 * Do tests 15--18
663 *
664 CALL DBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
665 $ VTSAV, LDVT, WORK, RESULT( 15 ) )
666 IF( M.NE.0 .AND. N.NE.0 ) THEN
667 CALL DORT01( 'Columns', M, M, USAV, LDU, WORK,
668 $ LWORK, RESULT( 16 ) )
669 CALL DORT01( 'Rows', N, N, VTSAV, LDVT, WORK,
670 $ LWORK, RESULT( 17 ) )
671 END IF
672 RESULT( 18 ) = ZERO
673 DO 200 I = 1, MNMIN - 1
674 IF( SSAV( I ).LT.SSAV( I+1 ) )
675 $ RESULT( 18 ) = ULPINV
676 IF( SSAV( I ).LT.ZERO )
677 $ RESULT( 18 ) = ULPINV
678 200 CONTINUE
679 IF( MNMIN.GE.1 ) THEN
680 IF( SSAV( MNMIN ).LT.ZERO )
681 $ RESULT( 18 ) = ULPINV
682 END IF
683 END IF
684 *
685 * Test DGEJSV: Factorize A
686 * Note: DGEJSV does not work for M < N
687 *
688 RESULT( 19 ) = ZERO
689 RESULT( 20 ) = ZERO
690 RESULT( 21 ) = ZERO
691 RESULT( 22 ) = ZERO
692 IF( M.GE.N ) THEN
693 IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N )
694 LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
695 LSWORK = MIN( LSWORK, LWORK )
696 LSWORK = MAX( LSWORK, 1 )
697 IF( IWS.EQ.4 )
698 $ LSWORK = LWORK
699 *
700 CALL DLACPY( 'F', M, N, ASAV, LDA, VTSAV, LDA )
701 SRNAMT = 'DGEJSV'
702 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
703 & M, N, VTSAV, LDA, SSAV, USAV, LDU, A, LDVT,
704 & WORK, LWORK, IWORK, INFO )
705 *
706 * DGEJSV retuns V not VT, so we transpose to use the same
707 * test suite.
708 *
709 DO J=1,N
710 DO I=1,N
711 VTSAV(J,I) = A(I,J)
712 END DO
713 END DO
714 *
715 IF( IINFO.NE.0 ) THEN
716 WRITE( NOUT, FMT = 9995 )'GESVJ', IINFO, M, N,
717 $ JTYPE, LSWORK, IOLDSD
718 INFO = ABS( IINFO )
719 RETURN
720 END IF
721 *
722 * Do tests 19--22
723 *
724 CALL DBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
725 $ VTSAV, LDVT, WORK, RESULT( 19 ) )
726 IF( M.NE.0 .AND. N.NE.0 ) THEN
727 CALL DORT01( 'Columns', M, M, USAV, LDU, WORK,
728 $ LWORK, RESULT( 20 ) )
729 CALL DORT01( 'Rows', N, N, VTSAV, LDVT, WORK,
730 $ LWORK, RESULT( 21 ) )
731 END IF
732 RESULT( 22 ) = ZERO
733 DO 300 I = 1, MNMIN - 1
734 IF( SSAV( I ).LT.SSAV( I+1 ) )
735 $ RESULT( 22 ) = ULPINV
736 IF( SSAV( I ).LT.ZERO )
737 $ RESULT( 22 ) = ULPINV
738 300 CONTINUE
739 IF( MNMIN.GE.1 ) THEN
740 IF( SSAV( MNMIN ).LT.ZERO )
741 $ RESULT( 22 ) = ULPINV
742 END IF
743 END IF
744 *
745 * End of Loop -- Check for RESULT(j) > THRESH
746 *
747 DO 120 J = 1, 22
748 IF( RESULT( J ).GE.THRESH ) THEN
749 IF( NFAIL.EQ.0 ) THEN
750 WRITE( NOUT, FMT = 9999 )
751 WRITE( NOUT, FMT = 9998 )
752 END IF
753 WRITE( NOUT, FMT = 9997 )M, N, JTYPE, IWS, IOLDSD,
754 $ J, RESULT( J )
755 NFAIL = NFAIL + 1
756 END IF
757 120 CONTINUE
758 NTEST = NTEST + 22
759 *
760 130 CONTINUE
761 140 CONTINUE
762 150 CONTINUE
763 *
764 * Summary
765 *
766 CALL ALASVM( PATH, NOUT, NFAIL, NTEST, 0 )
767 *
768 9999 FORMAT( ' SVD -- Real Singular Value Decomposition Driver ',
769 $ / ' Matrix types (see DDRVBD for details):',
770 $ / / ' 1 = Zero matrix', / ' 2 = Identity matrix',
771 $ / ' 3 = Evenly spaced singular values near 1',
772 $ / ' 4 = Evenly spaced singular values near underflow',
773 $ / ' 5 = Evenly spaced singular values near overflow', / /
774 $ ' Tests performed: ( A is dense, U and V are orthogonal,',
775 $ / 19X, ' S is an array, and Upartial, VTpartial, and',
776 $ / 19X, ' Spartial are partially computed U, VT and S),', / )
777 9998 FORMAT( ' 1 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
778 $ / ' 2 = | I - U**T U | / ( M ulp ) ',
779 $ / ' 3 = | I - VT VT**T | / ( N ulp ) ',
780 $ / ' 4 = 0 if S contains min(M,N) nonnegative values in',
781 $ ' decreasing order, else 1/ulp',
782 $ / ' 5 = | U - Upartial | / ( M ulp )',
783 $ / ' 6 = | VT - VTpartial | / ( N ulp )',
784 $ / ' 7 = | S - Spartial | / ( min(M,N) ulp |S| )',
785 $ / ' 8 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
786 $ / ' 9 = | I - U**T U | / ( M ulp ) ',
787 $ / '10 = | I - VT VT**T | / ( N ulp ) ',
788 $ / '11 = 0 if S contains min(M,N) nonnegative values in',
789 $ ' decreasing order, else 1/ulp',
790 $ / '12 = | U - Upartial | / ( M ulp )',
791 $ / '13 = | VT - VTpartial | / ( N ulp )',
792 $ / '14 = | S - Spartial | / ( min(M,N) ulp |S| )',
793 $ / '15 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
794 $ / '16 = | I - U**T U | / ( M ulp ) ',
795 $ / '17 = | I - VT VT**T | / ( N ulp ) ',
796 $ / '18 = 0 if S contains min(M,N) nonnegative values in',
797 $ ' decreasing order, else 1/ulp',
798 $ / '19 = | U - Upartial | / ( M ulp )',
799 $ / '20 = | VT - VTpartial | / ( N ulp )',
800 $ / '21 = | S - Spartial | / ( min(M,N) ulp |S| )', / / )
801 9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1,
802 $ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 )
803 9996 FORMAT( ' DDRVBD: ', A, ' returned INFO=', I6, '.', / 9X, 'M=',
804 $ I6, ', N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ),
805 $ I5, ')' )
806 9995 FORMAT( ' DDRVBD: ', A, ' returned INFO=', I6, '.', / 9X, 'M=',
807 $ I6, ', N=', I6, ', JTYPE=', I6, ', LSWORK=', I6, / 9X,
808 $ 'ISEED=(', 3( I5, ',' ), I5, ')' )
809 *
810 RETURN
811 *
812 * End of DDRVBD
813 *
814 END