LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
derred.f
Go to the documentation of this file.
1 *> \brief \b DERRED
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 DERRED( PATH, NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * CHARACTER*3 PATH
15 * INTEGER NUNIT
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> DERRED tests the error exits for the eigenvalue driver routines for
25 *> DOUBLE PRECISION matrices:
26 *>
27 *> PATH driver description
28 *> ---- ------ -----------
29 *> SEV DGEEV find eigenvalues/eigenvectors for nonsymmetric A
30 *> SES DGEES find eigenvalues/Schur form for nonsymmetric A
31 *> SVX DGEEVX SGEEV + balancing and condition estimation
32 *> SSX DGEESX SGEES + balancing and condition estimation
33 *> DBD DGESVD compute SVD of an M-by-N matrix A
34 *> DGESDD compute SVD of an M-by-N matrix A (by divide and
35 *> conquer)
36 *> DGEJSV compute SVD of an M-by-N matrix A where M >= N
37 *> DGESVDX compute SVD of an M-by-N matrix A(by bisection
38 *> and inverse iteration)
39 *> \endverbatim
40 *
41 * Arguments:
42 * ==========
43 *
44 *> \param[in] PATH
45 *> \verbatim
46 *> PATH is CHARACTER*3
47 *> The LAPACK path name for the routines to be tested.
48 *> \endverbatim
49 *>
50 *> \param[in] NUNIT
51 *> \verbatim
52 *> NUNIT is INTEGER
53 *> The unit number for output.
54 *> \endverbatim
55 *
56 * Authors:
57 * ========
58 *
59 *> \author Univ. of Tennessee
60 *> \author Univ. of California Berkeley
61 *> \author Univ. of Colorado Denver
62 *> \author NAG Ltd.
63 *
64 *> \date June 2016
65 *
66 *> \ingroup double_eig
67 *
68 * =====================================================================
69  SUBROUTINE derred( PATH, NUNIT )
70 *
71 * -- LAPACK test routine (version 3.6.1) --
72 * -- LAPACK is a software package provided by Univ. of Tennessee, --
73 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
74 * June 2016
75 *
76 * .. Scalar Arguments ..
77  CHARACTER*3 PATH
78  INTEGER NUNIT
79 * ..
80 *
81 * =====================================================================
82 *
83 * .. Parameters ..
84  INTEGER NMAX
85  DOUBLE PRECISION ONE, ZERO
86  parameter ( nmax = 4, one = 1.0d0, zero = 0.0d0 )
87 * ..
88 * .. Local Scalars ..
89  CHARACTER*2 C2
90  INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
91  DOUBLE PRECISION ABNRM
92 * ..
93 * .. Local Arrays ..
94  LOGICAL B( nmax )
95  INTEGER IW( 2*nmax )
96  DOUBLE PRECISION A( nmax, nmax ), R1( nmax ), R2( nmax ),
97  $ s( nmax ), u( nmax, nmax ), vl( nmax, nmax ),
98  $ vr( nmax, nmax ), vt( nmax, nmax ),
99  $ w( 10*nmax ), wi( nmax ), wr( nmax )
100 * ..
101 * .. External Subroutines ..
102  EXTERNAL chkxer, dgees, dgeesx, dgeev, dgeevx, dgejsv,
103  $ dgesdd, dgesvd
104 * ..
105 * .. External Functions ..
106  LOGICAL DSLECT, LSAMEN
107  EXTERNAL dslect, lsamen
108 * ..
109 * .. Intrinsic Functions ..
110  INTRINSIC len_trim
111 * ..
112 * .. Arrays in Common ..
113  LOGICAL SELVAL( 20 )
114  DOUBLE PRECISION SELWI( 20 ), SELWR( 20 )
115 * ..
116 * .. Scalars in Common ..
117  LOGICAL LERR, OK
118  CHARACTER*32 SRNAMT
119  INTEGER INFOT, NOUT, SELDIM, SELOPT
120 * ..
121 * .. Common blocks ..
122  COMMON / infoc / infot, nout, ok, lerr
123  COMMON / srnamc / srnamt
124  COMMON / sslct / selopt, seldim, selval, selwr, selwi
125 * ..
126 * .. Executable Statements ..
127 *
128  nout = nunit
129  WRITE( nout, fmt = * )
130  c2 = path( 2: 3 )
131 *
132 * Initialize A
133 *
134  DO 20 j = 1, nmax
135  DO 10 i = 1, nmax
136  a( i, j ) = zero
137  10 CONTINUE
138  20 CONTINUE
139  DO 30 i = 1, nmax
140  a( i, i ) = one
141  30 CONTINUE
142  ok = .true.
143  nt = 0
144 *
145  IF( lsamen( 2, c2, 'EV' ) ) THEN
146 *
147 * Test DGEEV
148 *
149  srnamt = 'DGEEV '
150  infot = 1
151  CALL dgeev( 'X', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
152  $ info )
153  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
154  infot = 2
155  CALL dgeev( 'N', 'X', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
156  $ info )
157  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
158  infot = 3
159  CALL dgeev( 'N', 'N', -1, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
160  $ info )
161  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
162  infot = 5
163  CALL dgeev( 'N', 'N', 2, a, 1, wr, wi, vl, 1, vr, 1, w, 6,
164  $ info )
165  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
166  infot = 9
167  CALL dgeev( 'V', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
168  $ info )
169  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
170  infot = 11
171  CALL dgeev( 'N', 'V', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
172  $ info )
173  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
174  infot = 13
175  CALL dgeev( 'V', 'V', 1, a, 1, wr, wi, vl, 1, vr, 1, w, 3,
176  $ info )
177  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
178  nt = nt + 7
179 *
180  ELSE IF( lsamen( 2, c2, 'ES' ) ) THEN
181 *
182 * Test DGEES
183 *
184  srnamt = 'DGEES '
185  infot = 1
186  CALL dgees( 'X', 'N', dslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
187  $ 1, b, info )
188  CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
189  infot = 2
190  CALL dgees( 'N', 'X', dslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
191  $ 1, b, info )
192  CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
193  infot = 4
194  CALL dgees( 'N', 'S', dslect, -1, a, 1, sdim, wr, wi, vl, 1, w,
195  $ 1, b, info )
196  CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
197  infot = 6
198  CALL dgees( 'N', 'S', dslect, 2, a, 1, sdim, wr, wi, vl, 1, w,
199  $ 6, b, info )
200  CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
201  infot = 11
202  CALL dgees( 'V', 'S', dslect, 2, a, 2, sdim, wr, wi, vl, 1, w,
203  $ 6, b, info )
204  CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
205  infot = 13
206  CALL dgees( 'N', 'S', dslect, 1, a, 1, sdim, wr, wi, vl, 1, w,
207  $ 2, b, info )
208  CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
209  nt = nt + 6
210 *
211  ELSE IF( lsamen( 2, c2, 'VX' ) ) THEN
212 *
213 * Test DGEEVX
214 *
215  srnamt = 'DGEEVX'
216  infot = 1
217  CALL dgeevx( 'X', 'N', 'N', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
218  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
219  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
220  infot = 2
221  CALL dgeevx( 'N', 'X', 'N', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
222  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
223  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
224  infot = 3
225  CALL dgeevx( 'N', 'N', 'X', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
226  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
227  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
228  infot = 4
229  CALL dgeevx( 'N', 'N', 'N', 'X', 0, a, 1, wr, wi, vl, 1, vr, 1,
230  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
231  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
232  infot = 5
233  CALL dgeevx( 'N', 'N', 'N', 'N', -1, a, 1, wr, wi, vl, 1, vr,
234  $ 1, ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
235  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
236  infot = 7
237  CALL dgeevx( 'N', 'N', 'N', 'N', 2, a, 1, wr, wi, vl, 1, vr, 1,
238  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
239  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
240  infot = 11
241  CALL dgeevx( 'N', 'V', 'N', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1,
242  $ ilo, ihi, s, abnrm, r1, r2, w, 6, iw, info )
243  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
244  infot = 13
245  CALL dgeevx( 'N', 'N', 'V', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1,
246  $ ilo, ihi, s, abnrm, r1, r2, w, 6, iw, info )
247  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
248  infot = 21
249  CALL dgeevx( 'N', 'N', 'N', 'N', 1, a, 1, wr, wi, vl, 1, vr, 1,
250  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
251  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
252  infot = 21
253  CALL dgeevx( 'N', 'V', 'N', 'N', 1, a, 1, wr, wi, vl, 1, vr, 1,
254  $ ilo, ihi, s, abnrm, r1, r2, w, 2, iw, info )
255  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
256  infot = 21
257  CALL dgeevx( 'N', 'N', 'V', 'V', 1, a, 1, wr, wi, vl, 1, vr, 1,
258  $ ilo, ihi, s, abnrm, r1, r2, w, 3, iw, info )
259  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
260  nt = nt + 11
261 *
262  ELSE IF( lsamen( 2, c2, 'SX' ) ) THEN
263 *
264 * Test DGEESX
265 *
266  srnamt = 'DGEESX'
267  infot = 1
268  CALL dgeesx( 'X', 'N', dslect, 'N', 0, a, 1, sdim, wr, wi, vl,
269  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
270  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
271  infot = 2
272  CALL dgeesx( 'N', 'X', dslect, 'N', 0, a, 1, sdim, wr, wi, vl,
273  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
274  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
275  infot = 4
276  CALL dgeesx( 'N', 'N', dslect, 'X', 0, a, 1, sdim, wr, wi, vl,
277  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
278  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
279  infot = 5
280  CALL dgeesx( 'N', 'N', dslect, 'N', -1, a, 1, sdim, wr, wi, vl,
281  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
282  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
283  infot = 7
284  CALL dgeesx( 'N', 'N', dslect, 'N', 2, a, 1, sdim, wr, wi, vl,
285  $ 1, r1( 1 ), r2( 1 ), w, 6, iw, 1, b, info )
286  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
287  infot = 12
288  CALL dgeesx( 'V', 'N', dslect, 'N', 2, a, 2, sdim, wr, wi, vl,
289  $ 1, r1( 1 ), r2( 1 ), w, 6, iw, 1, b, info )
290  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
291  infot = 16
292  CALL dgeesx( 'N', 'N', dslect, 'N', 1, a, 1, sdim, wr, wi, vl,
293  $ 1, r1( 1 ), r2( 1 ), w, 2, iw, 1, b, info )
294  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
295  nt = nt + 7
296 *
297  ELSE IF( lsamen( 2, c2, 'BD' ) ) THEN
298 *
299 * Test DGESVD
300 *
301  srnamt = 'DGESVD'
302  infot = 1
303  CALL dgesvd( 'X', 'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
304  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
305  infot = 2
306  CALL dgesvd( 'N', 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
307  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
308  infot = 2
309  CALL dgesvd( 'O', 'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
310  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
311  infot = 3
312  CALL dgesvd( 'N', 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1,
313  $ info )
314  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
315  infot = 4
316  CALL dgesvd( 'N', 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1,
317  $ info )
318  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
319  infot = 6
320  CALL dgesvd( 'N', 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, info )
321  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
322  infot = 9
323  CALL dgesvd( 'A', 'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, info )
324  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
325  infot = 11
326  CALL dgesvd( 'N', 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, info )
327  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
328  nt = 8
329  IF( ok ) THEN
330  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
331  $ nt
332  ELSE
333  WRITE( nout, fmt = 9998 )
334  END IF
335 *
336 * Test DGESDD
337 *
338  srnamt = 'DGESDD'
339  infot = 1
340  CALL dgesdd( 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
341  CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
342  infot = 2
343  CALL dgesdd( 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
344  CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
345  infot = 3
346  CALL dgesdd( 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
347  CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
348  infot = 5
349  CALL dgesdd( 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
350  CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
351  infot = 8
352  CALL dgesdd( 'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, iw, info )
353  CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
354  infot = 10
355  CALL dgesdd( 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
356  CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
357  nt = 6
358  IF( ok ) THEN
359  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
360  $ nt
361  ELSE
362  WRITE( nout, fmt = 9998 )
363  END IF
364 *
365 * Test DGEJSV
366 *
367  srnamt = 'DGEJSV'
368  infot = 1
369  CALL dgejsv( 'X', 'U', 'V', 'R', 'N', 'N',
370  $ 0, 0, a, 1, s, u, 1, vt, 1,
371  $ w, 1, iw, info)
372  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
373  infot = 2
374  CALL dgejsv( 'G', 'X', 'V', 'R', 'N', 'N',
375  $ 0, 0, a, 1, s, u, 1, vt, 1,
376  $ w, 1, iw, info)
377  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
378  infot = 3
379  CALL dgejsv( 'G', 'U', 'X', 'R', 'N', 'N',
380  $ 0, 0, a, 1, s, u, 1, vt, 1,
381  $ w, 1, iw, info)
382  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
383  infot = 4
384  CALL dgejsv( 'G', 'U', 'V', 'X', 'N', 'N',
385  $ 0, 0, a, 1, s, u, 1, vt, 1,
386  $ w, 1, iw, info)
387  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
388  infot = 5
389  CALL dgejsv( 'G', 'U', 'V', 'R', 'X', 'N',
390  $ 0, 0, a, 1, s, u, 1, vt, 1,
391  $ w, 1, iw, info)
392  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
393  infot = 6
394  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'X',
395  $ 0, 0, a, 1, s, u, 1, vt, 1,
396  $ w, 1, iw, info)
397  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
398  infot = 7
399  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
400  $ -1, 0, a, 1, s, u, 1, vt, 1,
401  $ w, 1, iw, info)
402  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
403  infot = 8
404  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
405  $ 0, -1, a, 1, s, u, 1, vt, 1,
406  $ w, 1, iw, info)
407  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
408  infot = 10
409  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
410  $ 2, 1, a, 1, s, u, 1, vt, 1,
411  $ w, 1, iw, info)
412  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
413  infot = 13
414  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
415  $ 2, 2, a, 2, s, u, 1, vt, 2,
416  $ w, 1, iw, info)
417  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
418  infot = 14
419  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
420  $ 2, 2, a, 2, s, u, 2, vt, 1,
421  $ w, 1, iw, info)
422  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
423  nt = 11
424  IF( ok ) THEN
425  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
426  $ nt
427  ELSE
428  WRITE( nout, fmt = 9998 )
429  END IF
430 *
431 * Test DGESVDX
432 *
433  srnamt = 'DGESVDX'
434  infot = 1
435  CALL dgesvdx( 'X', 'N', 'A', 0, 0, a, 1, zero, zero,
436  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
437  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
438  infot = 2
439  CALL dgesvdx( 'N', 'X', 'A', 0, 0, a, 1, zero, zero,
440  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
441  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
442  infot = 3
443  CALL dgesvdx( 'N', 'N', 'X', 0, 0, a, 1, zero, zero,
444  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
445  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
446  infot = 4
447  CALL dgesvdx( 'N', 'N', 'A', -1, 0, a, 1, zero, zero,
448  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
449  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
450  infot = 5
451  CALL dgesvdx( 'N', 'N', 'A', 0, -1, a, 1, zero, zero,
452  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
453  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
454  infot = 7
455  CALL dgesvdx( 'N', 'N', 'A', 2, 1, a, 1, zero, zero,
456  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
457  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
458  infot = 8
459  CALL dgesvdx( 'N', 'N', 'V', 2, 1, a, 2, -one, zero,
460  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
461  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
462  infot = 9
463  CALL dgesvdx( 'N', 'N', 'V', 2, 1, a, 2, one, zero,
464  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
465  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
466  infot = 10
467  CALL dgesvdx( 'N', 'N', 'I', 2, 2, a, 2, zero, zero,
468  $ 0, 1, ns, s, u, 1, vt, 1, w, 1, iw, info )
469  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
470  infot = 11
471  CALL dgesvdx( 'V', 'N', 'I', 2, 2, a, 2, zero, zero,
472  $ 1, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
473  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
474  infot = 15
475  CALL dgesvdx( 'V', 'N', 'A', 2, 2, a, 2, zero, zero,
476  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
477  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
478  infot = 17
479  CALL dgesvdx( 'N', 'V', 'A', 2, 2, a, 2, zero, zero,
480  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
481  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
482  nt = 12
483  IF( ok ) THEN
484  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
485  $ nt
486  ELSE
487  WRITE( nout, fmt = 9998 )
488  END IF
489  END IF
490 *
491 * Print a summary line.
492 *
493  IF( .NOT.lsamen( 2, c2, 'BD' ) ) THEN
494  IF( ok ) THEN
495  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
496  $ nt
497  ELSE
498  WRITE( nout, fmt = 9998 )
499  END IF
500  END IF
501 *
502  9999 FORMAT( 1x, a, ' passed the tests of the error exits (', i3,
503  $ ' tests done)' )
504  9998 FORMAT( ' *** ', a, ' failed the tests of the error exits ***' )
505  RETURN
506 *
507 * End of DERRED
508  END
dgeesx
subroutine dgeesx(JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, IWORK, LIWORK, BWORK, INFO)
DGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE...
Definition: dgeesx.f:283
dgeevx
subroutine dgeevx(BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, IWORK, INFO)
DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: dgeevx.f:307
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
dgesdd
subroutine dgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
DGESDD
Definition: dgesdd.f:221
derred
subroutine derred(PATH, NUNIT)
DERRED
Definition: derred.f:70
dgesvdx
subroutine dgesvdx(JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, IL, IU, NS, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
DGESVDX computes the singular value decomposition (SVD) for GE matrices
Definition: dgesvdx.f:265
dgeev
subroutine dgeev(JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, WORK, LWORK, INFO)
DGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: dgeev.f:193
dgees
subroutine dgees(JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, VS, LDVS, WORK, LWORK, BWORK, INFO)
DGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
Definition: dgees.f:218
dgesvd
subroutine dgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, INFO)
DGESVD computes the singular value decomposition (SVD) for GE matrices
Definition: dgesvd.f:213
dgejsv
subroutine dgejsv(JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, M, N, A, LDA, SVA, U, LDU, V, LDV, WORK, LWORK, IWORK, INFO)
DGEJSV
Definition: dgejsv.f:478