LAPACK  3.6.0
LAPACK: Linear Algebra PACKage
serred.f
Go to the documentation of this file.
1 *> \brief \b SERRED
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 SERRED( 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 *> SERRED tests the error exits for the eigenvalue driver routines for
25 *> REAL matrices:
26 *>
27 *> PATH driver description
28 *> ---- ------ -----------
29 *> SEV SGEEV find eigenvalues/eigenvectors for nonsymmetric A
30 *> SES SGEES find eigenvalues/Schur form for nonsymmetric A
31 *> SVX SGEEVX SGEEV + balancing and condition estimation
32 *> SSX SGEESX SGEES + balancing and condition estimation
33 *> SBD SGESVD compute SVD of an M-by-N matrix A
34 *> SGESDD compute SVD of an M-by-N matrix A (by divide and
35 *> conquer)
36 *> SGEJSV compute SVD of an M-by-N matrix A where M >= N
37 *> SGESVDX 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 November 2015
65 *
66 *> \ingroup single_eig
67 *
68 * =====================================================================
69  SUBROUTINE serred( PATH, NUNIT )
70 *
71 * -- LAPACK test routine (version 3.6.0) --
72 * -- LAPACK is a software package provided by Univ. of Tennessee, --
73 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
74 * November 2015
75 *
76 * .. Scalar Arguments ..
77  CHARACTER*3 PATH
78  INTEGER NUNIT
79 * ..
80 *
81 * =====================================================================
82 *
83 * .. Parameters ..
84  INTEGER NMAX
85  REAL ONE, ZERO
86  parameter( nmax = 4, one = 1.0e0, zero = 0.0e0 )
87 * ..
88 * .. Local Scalars ..
89  CHARACTER*2 C2
90  INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
91  REAL ABNRM
92 * ..
93 * .. Local Arrays ..
94  LOGICAL B( nmax )
95  INTEGER IW( 2*nmax )
96  REAL 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, sgees, sgeesx, sgeev, sgeevx, sgejsv,
103  $ sgesdd, sgesvd
104 * ..
105 * .. External Functions ..
106  LOGICAL SSLECT, LSAMEN
107  EXTERNAL sslect, lsamen
108 * ..
109 * .. Intrinsic Functions ..
110  INTRINSIC len_trim
111 * ..
112 * .. Arrays in Common ..
113  LOGICAL SELVAL( 20 )
114  REAL 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 SGEEV
148 *
149  srnamt = 'SGEEV '
150  infot = 1
151  CALL sgeev( 'X', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
152  $ info )
153  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
154  infot = 2
155  CALL sgeev( 'N', 'X', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
156  $ info )
157  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
158  infot = 3
159  CALL sgeev( 'N', 'N', -1, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
160  $ info )
161  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
162  infot = 5
163  CALL sgeev( 'N', 'N', 2, a, 1, wr, wi, vl, 1, vr, 1, w, 6,
164  $ info )
165  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
166  infot = 9
167  CALL sgeev( 'V', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
168  $ info )
169  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
170  infot = 11
171  CALL sgeev( 'N', 'V', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
172  $ info )
173  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
174  infot = 13
175  CALL sgeev( 'V', 'V', 1, a, 1, wr, wi, vl, 1, vr, 1, w, 3,
176  $ info )
177  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
178  nt = nt + 7
179 *
180  ELSE IF( lsamen( 2, c2, 'ES' ) ) THEN
181 *
182 * Test SGEES
183 *
184  srnamt = 'SGEES '
185  infot = 1
186  CALL sgees( 'X', 'N', sslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
187  $ 1, b, info )
188  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
189  infot = 2
190  CALL sgees( 'N', 'X', sslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
191  $ 1, b, info )
192  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
193  infot = 4
194  CALL sgees( 'N', 'S', sslect, -1, a, 1, sdim, wr, wi, vl, 1, w,
195  $ 1, b, info )
196  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
197  infot = 6
198  CALL sgees( 'N', 'S', sslect, 2, a, 1, sdim, wr, wi, vl, 1, w,
199  $ 6, b, info )
200  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
201  infot = 11
202  CALL sgees( 'V', 'S', sslect, 2, a, 2, sdim, wr, wi, vl, 1, w,
203  $ 6, b, info )
204  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
205  infot = 13
206  CALL sgees( 'N', 'S', sslect, 1, a, 1, sdim, wr, wi, vl, 1, w,
207  $ 2, b, info )
208  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
209  nt = nt + 6
210 *
211  ELSE IF( lsamen( 2, c2, 'VX' ) ) THEN
212 *
213 * Test SGEEVX
214 *
215  srnamt = 'SGEEVX'
216  infot = 1
217  CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
220  infot = 2
221  CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
224  infot = 3
225  CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
228  infot = 4
229  CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
232  infot = 5
233  CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
236  infot = 7
237  CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
240  infot = 11
241  CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
244  infot = 13
245  CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
248  infot = 21
249  CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
252  infot = 21
253  CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
256  infot = 21
257  CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
260  nt = nt + 11
261 *
262  ELSE IF( lsamen( 2, c2, 'SX' ) ) THEN
263 *
264 * Test SGEESX
265 *
266  srnamt = 'SGEESX'
267  infot = 1
268  CALL sgeesx( 'X', 'N', sslect, 'N', 0, a, 1, sdim, wr, wi, vl,
269  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
270  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
271  infot = 2
272  CALL sgeesx( 'N', 'X', sslect, 'N', 0, a, 1, sdim, wr, wi, vl,
273  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
274  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
275  infot = 4
276  CALL sgeesx( 'N', 'N', sslect, 'X', 0, a, 1, sdim, wr, wi, vl,
277  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
278  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
279  infot = 5
280  CALL sgeesx( 'N', 'N', sslect, 'N', -1, a, 1, sdim, wr, wi, vl,
281  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
282  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
283  infot = 7
284  CALL sgeesx( 'N', 'N', sslect, 'N', 2, a, 1, sdim, wr, wi, vl,
285  $ 1, r1( 1 ), r2( 1 ), w, 6, iw, 1, b, info )
286  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
287  infot = 12
288  CALL sgeesx( 'V', 'N', sslect, 'N', 2, a, 2, sdim, wr, wi, vl,
289  $ 1, r1( 1 ), r2( 1 ), w, 6, iw, 1, b, info )
290  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
291  infot = 16
292  CALL sgeesx( 'N', 'N', sslect, 'N', 1, a, 1, sdim, wr, wi, vl,
293  $ 1, r1( 1 ), r2( 1 ), w, 2, iw, 1, b, info )
294  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
295  nt = nt + 7
296 *
297  ELSE IF( lsamen( 2, c2, 'BD' ) ) THEN
298 *
299 * Test SGESVD
300 *
301  srnamt = 'SGESVD'
302  infot = 1
303  CALL sgesvd( 'X', 'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
304  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
305  infot = 2
306  CALL sgesvd( 'N', 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
307  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
308  infot = 2
309  CALL sgesvd( 'O', 'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
310  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
311  infot = 3
312  CALL sgesvd( 'N', 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1,
313  $ info )
314  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
315  infot = 4
316  CALL sgesvd( 'N', 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1,
317  $ info )
318  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
319  infot = 6
320  CALL sgesvd( 'N', 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, info )
321  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
322  infot = 9
323  CALL sgesvd( 'A', 'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, info )
324  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
325  infot = 11
326  CALL sgesvd( 'N', 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, info )
327  CALL chkxer( 'SGESVD', 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 SGESDD
337 *
338  srnamt = 'SGESDD'
339  infot = 1
340  CALL sgesdd( 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
341  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
342  infot = 2
343  CALL sgesdd( 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
344  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
345  infot = 3
346  CALL sgesdd( 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
347  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
348  infot = 5
349  CALL sgesdd( 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
350  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
351  infot = 8
352  CALL sgesdd( 'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, iw, info )
353  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
354  infot = 10
355  CALL sgesdd( 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
356  CALL chkxer( 'SGESDD', 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 SGEJSV
366 *
367  srnamt = 'SGEJSV'
368  infot = 1
369  CALL sgejsv( 'X', 'U', 'V', 'R', 'N', 'N',
370  $ 0, 0, a, 1, s, u, 1, vt, 1,
371  $ w, 1, iw, info)
372  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
373  infot = 2
374  CALL sgejsv( 'G', 'X', 'V', 'R', 'N', 'N',
375  $ 0, 0, a, 1, s, u, 1, vt, 1,
376  $ w, 1, iw, info)
377  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
378  infot = 3
379  CALL sgejsv( 'G', 'U', 'X', 'R', 'N', 'N',
380  $ 0, 0, a, 1, s, u, 1, vt, 1,
381  $ w, 1, iw, info)
382  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
383  infot = 4
384  CALL sgejsv( 'G', 'U', 'V', 'X', 'N', 'N',
385  $ 0, 0, a, 1, s, u, 1, vt, 1,
386  $ w, 1, iw, info)
387  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
388  infot = 5
389  CALL sgejsv( 'G', 'U', 'V', 'R', 'X', 'N',
390  $ 0, 0, a, 1, s, u, 1, vt, 1,
391  $ w, 1, iw, info)
392  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
393  infot = 6
394  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'X',
395  $ 0, 0, a, 1, s, u, 1, vt, 1,
396  $ w, 1, iw, info)
397  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
398  infot = 7
399  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
400  $ -1, 0, a, 1, s, u, 1, vt, 1,
401  $ w, 1, iw, info)
402  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
403  infot = 8
404  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
405  $ 0, -1, a, 1, s, u, 1, vt, 1,
406  $ w, 1, iw, info)
407  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
408  infot = 10
409  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
410  $ 2, 1, a, 1, s, u, 1, vt, 1,
411  $ w, 1, iw, info)
412  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
413  infot = 13
414  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
415  $ 2, 2, a, 2, s, u, 1, vt, 2,
416  $ w, 1, iw, info)
417  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
418  infot = 14
419  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
420  $ 2, 2, a, 2, s, u, 2, vt, 1,
421  $ w, 1, iw, info)
422  CALL chkxer( 'SGEJSV', 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 SGESVDX
432 *
433  srnamt = 'SGESVDX'
434  infot = 1
435  CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
438  infot = 2
439  CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
442  infot = 3
443  CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
446  infot = 4
447  CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
450  infot = 5
451  CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
454  infot = 7
455  CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
458  infot = 8
459  CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
462  infot = 9
463  CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
466  infot = 10
467  CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
470  infot = 11
471  CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
474  infot = 15
475  CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
478  infot = 16
479  CALL sgesvdx( '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( 'SGESVDX', 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 SERRED
508 *
509  END
subroutine sgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, INFO)
SGESVD computes the singular value decomposition (SVD) for GE matrices
Definition: sgesvd.f:213
subroutine sgesvdx(JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, IL, IU, NS, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
SGESVDX computes the singular value decomposition (SVD) for GE matrices
Definition: sgesvdx.f:259
subroutine sgeevx(BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, IWORK, INFO)
SGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: sgeevx.f:305
subroutine sgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
SGESDD
Definition: sgesdd.f:218
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine sgeev(JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, WORK, LWORK, INFO)
SGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: sgeev.f:191
subroutine serred(PATH, NUNIT)
SERRED
Definition: serred.f:70
subroutine sgeesx(JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, IWORK, LIWORK, BWORK, INFO)
SGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE...
Definition: sgeesx.f:283
subroutine sgees(JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, VS, LDVS, WORK, LWORK, BWORK, INFO)
SGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
Definition: sgees.f:218
subroutine sgejsv(JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, M, N, A, LDA, SVA, U, LDU, V, LDV, WORK, LWORK, IWORK, INFO)
SGEJSV
Definition: sgejsv.f:479