LAPACK  3.9.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 *> SGESVDQ compute SVD of an M-by-N matrix A(with a
40 *> QR-Preconditioned )
41 *> \endverbatim
42 *
43 * Arguments:
44 * ==========
45 *
46 *> \param[in] PATH
47 *> \verbatim
48 *> PATH is CHARACTER*3
49 *> The LAPACK path name for the routines to be tested.
50 *> \endverbatim
51 *>
52 *> \param[in] NUNIT
53 *> \verbatim
54 *> NUNIT is INTEGER
55 *> The unit number for output.
56 *> \endverbatim
57 *
58 * Authors:
59 * ========
60 *
61 *> \author Univ. of Tennessee
62 *> \author Univ. of California Berkeley
63 *> \author Univ. of Colorado Denver
64 *> \author NAG Ltd.
65 *
66 *> \date June 2016
67 *
68 *> \ingroup single_eig
69 *
70 * =====================================================================
71  SUBROUTINE serred( PATH, NUNIT )
72 *
73 * -- LAPACK test routine (version 3.7.0) --
74 * -- LAPACK is a software package provided by Univ. of Tennessee, --
75 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
76 * June 2016
77 *
78 * .. Scalar Arguments ..
79  CHARACTER*3 PATH
80  INTEGER NUNIT
81 * ..
82 *
83 * =====================================================================
84 *
85 * .. Parameters ..
86  INTEGER NMAX
87  REAL ONE, ZERO
88  parameter( nmax = 4, one = 1.0e0, zero = 0.0e0 )
89 * ..
90 * .. Local Scalars ..
91  CHARACTER*2 C2
92  INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
93  REAL ABNRM
94 * ..
95 * .. Local Arrays ..
96  LOGICAL B( NMAX )
97  INTEGER IW( 2*NMAX )
98  REAL A( NMAX, NMAX ), R1( NMAX ), R2( NMAX ),
99  $ S( NMAX ), U( NMAX, NMAX ), VL( NMAX, NMAX ),
100  $ VR( NMAX, NMAX ), VT( NMAX, NMAX ),
101  $ W( 10*NMAX ), WI( NMAX ), WR( NMAX )
102 * ..
103 * .. External Subroutines ..
104  EXTERNAL chkxer, sgees, sgeesx, sgeev, sgeevx, sgejsv,
105  $ sgesdd, sgesvd, sgesvdx, sgesvdq
106 * ..
107 * .. External Functions ..
108  LOGICAL SSLECT, LSAMEN
109  EXTERNAL sslect, lsamen
110 * ..
111 * .. Intrinsic Functions ..
112  INTRINSIC len_trim
113 * ..
114 * .. Arrays in Common ..
115  LOGICAL SELVAL( 20 )
116  REAL SELWI( 20 ), SELWR( 20 )
117 * ..
118 * .. Scalars in Common ..
119  LOGICAL LERR, OK
120  CHARACTER*32 SRNAMT
121  INTEGER INFOT, NOUT, SELDIM, SELOPT
122 * ..
123 * .. Common blocks ..
124  COMMON / infoc / infot, nout, ok, lerr
125  COMMON / srnamc / srnamt
126  COMMON / sslct / selopt, seldim, selval, selwr, selwi
127 * ..
128 * .. Executable Statements ..
129 *
130  nout = nunit
131  WRITE( nout, fmt = * )
132  c2 = path( 2: 3 )
133 *
134 * Initialize A
135 *
136  DO 20 j = 1, nmax
137  DO 10 i = 1, nmax
138  a( i, j ) = zero
139  10 CONTINUE
140  20 CONTINUE
141  DO 30 i = 1, nmax
142  a( i, i ) = one
143  30 CONTINUE
144  ok = .true.
145  nt = 0
146 *
147  IF( lsamen( 2, c2, 'EV' ) ) THEN
148 *
149 * Test SGEEV
150 *
151  srnamt = 'SGEEV '
152  infot = 1
153  CALL sgeev( 'X', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
154  $ info )
155  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
156  infot = 2
157  CALL sgeev( 'N', 'X', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
158  $ info )
159  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
160  infot = 3
161  CALL sgeev( 'N', 'N', -1, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
162  $ info )
163  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
164  infot = 5
165  CALL sgeev( 'N', 'N', 2, a, 1, wr, wi, vl, 1, vr, 1, w, 6,
166  $ info )
167  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
168  infot = 9
169  CALL sgeev( 'V', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
170  $ info )
171  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
172  infot = 11
173  CALL sgeev( 'N', 'V', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
174  $ info )
175  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
176  infot = 13
177  CALL sgeev( 'V', 'V', 1, a, 1, wr, wi, vl, 1, vr, 1, w, 3,
178  $ info )
179  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
180  nt = nt + 7
181 *
182  ELSE IF( lsamen( 2, c2, 'ES' ) ) THEN
183 *
184 * Test SGEES
185 *
186  srnamt = 'SGEES '
187  infot = 1
188  CALL sgees( 'X', 'N', sslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
189  $ 1, b, info )
190  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
191  infot = 2
192  CALL sgees( 'N', 'X', sslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
193  $ 1, b, info )
194  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
195  infot = 4
196  CALL sgees( 'N', 'S', sslect, -1, a, 1, sdim, wr, wi, vl, 1, w,
197  $ 1, b, info )
198  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
199  infot = 6
200  CALL sgees( 'N', 'S', sslect, 2, a, 1, sdim, wr, wi, vl, 1, w,
201  $ 6, b, info )
202  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
203  infot = 11
204  CALL sgees( 'V', 'S', sslect, 2, a, 2, sdim, wr, wi, vl, 1, w,
205  $ 6, b, info )
206  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
207  infot = 13
208  CALL sgees( 'N', 'S', sslect, 1, a, 1, sdim, wr, wi, vl, 1, w,
209  $ 2, b, info )
210  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
211  nt = nt + 6
212 *
213  ELSE IF( lsamen( 2, c2, 'VX' ) ) THEN
214 *
215 * Test SGEEVX
216 *
217  srnamt = 'SGEEVX'
218  infot = 1
219  CALL sgeevx( 'X', 'N', 'N', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
220  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
221  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
222  infot = 2
223  CALL sgeevx( 'N', 'X', 'N', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
224  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
225  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
226  infot = 3
227  CALL sgeevx( 'N', 'N', 'X', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
228  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
229  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
230  infot = 4
231  CALL sgeevx( 'N', 'N', 'N', 'X', 0, a, 1, wr, wi, vl, 1, vr, 1,
232  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
233  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
234  infot = 5
235  CALL sgeevx( 'N', 'N', 'N', 'N', -1, a, 1, wr, wi, vl, 1, vr,
236  $ 1, ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
237  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
238  infot = 7
239  CALL sgeevx( 'N', 'N', 'N', 'N', 2, a, 1, wr, wi, vl, 1, vr, 1,
240  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
241  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
242  infot = 11
243  CALL sgeevx( 'N', 'V', 'N', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1,
244  $ ilo, ihi, s, abnrm, r1, r2, w, 6, iw, info )
245  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
246  infot = 13
247  CALL sgeevx( 'N', 'N', 'V', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1,
248  $ ilo, ihi, s, abnrm, r1, r2, w, 6, iw, info )
249  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
250  infot = 21
251  CALL sgeevx( 'N', 'N', 'N', 'N', 1, a, 1, wr, wi, vl, 1, vr, 1,
252  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
253  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
254  infot = 21
255  CALL sgeevx( 'N', 'V', 'N', 'N', 1, a, 1, wr, wi, vl, 1, vr, 1,
256  $ ilo, ihi, s, abnrm, r1, r2, w, 2, iw, info )
257  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
258  infot = 21
259  CALL sgeevx( 'N', 'N', 'V', 'V', 1, a, 1, wr, wi, vl, 1, vr, 1,
260  $ ilo, ihi, s, abnrm, r1, r2, w, 3, iw, info )
261  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
262  nt = nt + 11
263 *
264  ELSE IF( lsamen( 2, c2, 'SX' ) ) THEN
265 *
266 * Test SGEESX
267 *
268  srnamt = 'SGEESX'
269  infot = 1
270  CALL sgeesx( 'X', 'N', sslect, 'N', 0, a, 1, sdim, wr, wi, vl,
271  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
272  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
273  infot = 2
274  CALL sgeesx( 'N', 'X', sslect, 'N', 0, a, 1, sdim, wr, wi, vl,
275  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
276  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
277  infot = 4
278  CALL sgeesx( 'N', 'N', sslect, 'X', 0, a, 1, sdim, wr, wi, vl,
279  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
280  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
281  infot = 5
282  CALL sgeesx( 'N', 'N', sslect, 'N', -1, a, 1, sdim, wr, wi, vl,
283  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
284  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
285  infot = 7
286  CALL sgeesx( 'N', 'N', sslect, 'N', 2, a, 1, sdim, wr, wi, vl,
287  $ 1, r1( 1 ), r2( 1 ), w, 6, iw, 1, b, info )
288  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
289  infot = 12
290  CALL sgeesx( 'V', 'N', sslect, 'N', 2, a, 2, sdim, wr, wi, vl,
291  $ 1, r1( 1 ), r2( 1 ), w, 6, iw, 1, b, info )
292  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
293  infot = 16
294  CALL sgeesx( 'N', 'N', sslect, 'N', 1, a, 1, sdim, wr, wi, vl,
295  $ 1, r1( 1 ), r2( 1 ), w, 2, iw, 1, b, info )
296  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
297  nt = nt + 7
298 *
299  ELSE IF( lsamen( 2, c2, 'BD' ) ) THEN
300 *
301 * Test SGESVD
302 *
303  srnamt = 'SGESVD'
304  infot = 1
305  CALL sgesvd( 'X', 'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
306  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
307  infot = 2
308  CALL sgesvd( 'N', 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
309  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
310  infot = 2
311  CALL sgesvd( 'O', 'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
312  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
313  infot = 3
314  CALL sgesvd( 'N', 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1,
315  $ info )
316  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
317  infot = 4
318  CALL sgesvd( 'N', 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1,
319  $ info )
320  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
321  infot = 6
322  CALL sgesvd( 'N', 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, info )
323  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
324  infot = 9
325  CALL sgesvd( 'A', 'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, info )
326  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
327  infot = 11
328  CALL sgesvd( 'N', 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, info )
329  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
330  nt = 8
331  IF( ok ) THEN
332  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
333  $ nt
334  ELSE
335  WRITE( nout, fmt = 9998 )
336  END IF
337 *
338 * Test SGESDD
339 *
340  srnamt = 'SGESDD'
341  infot = 1
342  CALL sgesdd( 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
343  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
344  infot = 2
345  CALL sgesdd( 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
346  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
347  infot = 3
348  CALL sgesdd( 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
349  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
350  infot = 5
351  CALL sgesdd( 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
352  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
353  infot = 8
354  CALL sgesdd( 'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, iw, info )
355  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
356  infot = 10
357  CALL sgesdd( 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
358  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
359  nt = 6
360  IF( ok ) THEN
361  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
362  $ nt
363  ELSE
364  WRITE( nout, fmt = 9998 )
365  END IF
366 *
367 * Test SGEJSV
368 *
369  srnamt = 'SGEJSV'
370  infot = 1
371  CALL sgejsv( 'X', 'U', 'V', 'R', 'N', 'N',
372  $ 0, 0, a, 1, s, u, 1, vt, 1,
373  $ w, 1, iw, info)
374  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
375  infot = 2
376  CALL sgejsv( 'G', 'X', 'V', 'R', 'N', 'N',
377  $ 0, 0, a, 1, s, u, 1, vt, 1,
378  $ w, 1, iw, info)
379  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
380  infot = 3
381  CALL sgejsv( 'G', 'U', 'X', 'R', 'N', 'N',
382  $ 0, 0, a, 1, s, u, 1, vt, 1,
383  $ w, 1, iw, info)
384  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
385  infot = 4
386  CALL sgejsv( 'G', 'U', 'V', 'X', 'N', 'N',
387  $ 0, 0, a, 1, s, u, 1, vt, 1,
388  $ w, 1, iw, info)
389  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
390  infot = 5
391  CALL sgejsv( 'G', 'U', 'V', 'R', 'X', 'N',
392  $ 0, 0, a, 1, s, u, 1, vt, 1,
393  $ w, 1, iw, info)
394  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
395  infot = 6
396  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'X',
397  $ 0, 0, a, 1, s, u, 1, vt, 1,
398  $ w, 1, iw, info)
399  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
400  infot = 7
401  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
402  $ -1, 0, a, 1, s, u, 1, vt, 1,
403  $ w, 1, iw, info)
404  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
405  infot = 8
406  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
407  $ 0, -1, a, 1, s, u, 1, vt, 1,
408  $ w, 1, iw, info)
409  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
410  infot = 10
411  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
412  $ 2, 1, a, 1, s, u, 1, vt, 1,
413  $ w, 1, iw, info)
414  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
415  infot = 13
416  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
417  $ 2, 2, a, 2, s, u, 1, vt, 2,
418  $ w, 1, iw, info)
419  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
420  infot = 15
421  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
422  $ 2, 2, a, 2, s, u, 2, vt, 1,
423  $ w, 1, iw, info)
424  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
425  nt = 11
426  IF( ok ) THEN
427  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
428  $ nt
429  ELSE
430  WRITE( nout, fmt = 9998 )
431  END IF
432 *
433 * Test SGESVDX
434 *
435  srnamt = 'SGESVDX'
436  infot = 1
437  CALL sgesvdx( 'X', 'N', 'A', 0, 0, a, 1, zero, zero,
438  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
439  CALL chkxer( 'SGESVDX', infot, nout, lerr, ok )
440  infot = 2
441  CALL sgesvdx( 'N', 'X', 'A', 0, 0, a, 1, zero, zero,
442  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
443  CALL chkxer( 'SGESVDX', infot, nout, lerr, ok )
444  infot = 3
445  CALL sgesvdx( 'N', 'N', 'X', 0, 0, a, 1, zero, zero,
446  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
447  CALL chkxer( 'SGESVDX', infot, nout, lerr, ok )
448  infot = 4
449  CALL sgesvdx( 'N', 'N', 'A', -1, 0, a, 1, zero, zero,
450  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
451  CALL chkxer( 'SGESVDX', infot, nout, lerr, ok )
452  infot = 5
453  CALL sgesvdx( 'N', 'N', 'A', 0, -1, a, 1, zero, zero,
454  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
455  CALL chkxer( 'SGESVDX', infot, nout, lerr, ok )
456  infot = 7
457  CALL sgesvdx( 'N', 'N', 'A', 2, 1, a, 1, zero, zero,
458  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
459  CALL chkxer( 'SGESVDX', infot, nout, lerr, ok )
460  infot = 8
461  CALL sgesvdx( 'N', 'N', 'V', 2, 1, a, 2, -one, zero,
462  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
463  CALL chkxer( 'SGESVDX', infot, nout, lerr, ok )
464  infot = 9
465  CALL sgesvdx( 'N', 'N', 'V', 2, 1, a, 2, one, zero,
466  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
467  CALL chkxer( 'SGESVDX', infot, nout, lerr, ok )
468  infot = 10
469  CALL sgesvdx( 'N', 'N', 'I', 2, 2, a, 2, zero, zero,
470  $ 0, 1, ns, s, u, 1, vt, 1, w, 1, iw, info )
471  CALL chkxer( 'SGESVDX', infot, nout, lerr, ok )
472  infot = 11
473  CALL sgesvdx( 'V', 'N', 'I', 2, 2, a, 2, zero, zero,
474  $ 1, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
475  CALL chkxer( 'SGESVDX', infot, nout, lerr, ok )
476  infot = 15
477  CALL sgesvdx( 'V', 'N', 'A', 2, 2, a, 2, zero, zero,
478  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
479  CALL chkxer( 'SGESVDX', infot, nout, lerr, ok )
480  infot = 17
481  CALL sgesvdx( 'N', 'V', 'A', 2, 2, a, 2, zero, zero,
482  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
483  CALL chkxer( 'SGESVDX', infot, nout, lerr, ok )
484  nt = 12
485  IF( ok ) THEN
486  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
487  $ nt
488  ELSE
489  WRITE( nout, fmt = 9998 )
490  END IF
491 *
492 * Test SGESVDQ
493 *
494  srnamt = 'SGESVDQ'
495  infot = 1
496  CALL sgesvdq( 'X', 'P', 'T', 'A', 'A', 0, 0, a, 1, s, u,
497  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
498  CALL chkxer( 'SGESVDQ', infot, nout, lerr, ok )
499  infot = 2
500  CALL sgesvdq( 'A', 'X', 'T', 'A', 'A', 0, 0, a, 1, s, u,
501  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
502  CALL chkxer( 'SGESVDQ', infot, nout, lerr, ok )
503  infot = 3
504  CALL sgesvdq( 'A', 'P', 'X', 'A', 'A', 0, 0, a, 1, s, u,
505  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
506  CALL chkxer( 'SGESVDQ', infot, nout, lerr, ok )
507  infot = 4
508  CALL sgesvdq( 'A', 'P', 'T', 'X', 'A', 0, 0, a, 1, s, u,
509  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
510  CALL chkxer( 'SGESVDQ', infot, nout, lerr, ok )
511  infot = 5
512  CALL sgesvdq( 'A', 'P', 'T', 'A', 'X', 0, 0, a, 1, s, u,
513  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
514  CALL chkxer( 'SGESVDQ', infot, nout, lerr, ok )
515  infot = 6
516  CALL sgesvdq( 'A', 'P', 'T', 'A', 'A', -1, 0, a, 1, s, u,
517  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
518  CALL chkxer( 'SGESVDQ', infot, nout, lerr, ok )
519  infot = 7
520  CALL sgesvdq( 'A', 'P', 'T', 'A', 'A', 0, 1, a, 1, s, u,
521  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
522  CALL chkxer( 'SGESVDQ', infot, nout, lerr, ok )
523  infot = 9
524  CALL sgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 0, s, u,
525  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
526  CALL chkxer( 'SGESVDQ', infot, nout, lerr, ok )
527  infot = 12
528  CALL sgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
529  $ -1, vt, 0, ns, iw, 1, w, 1, w, 1, info )
530  CALL chkxer( 'SGESVDQ', infot, nout, lerr, ok )
531  infot = 14
532  CALL sgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
533  $ 1, vt, -1, ns, iw, 1, w, 1, w, 1, info )
534  CALL chkxer( 'SGESVDQ', infot, nout, lerr, ok )
535  infot = 17
536  CALL sgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
537  $ 1, vt, 1, ns, iw, -5, w, 1, w, 1, info )
538  CALL chkxer( 'SGESVDQ', infot, nout, lerr, ok )
539  nt = 11
540  IF( ok ) THEN
541  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
542  $ nt
543  ELSE
544  WRITE( nout, fmt = 9998 )
545  END IF
546  END IF
547 *
548 * Print a summary line.
549 *
550  IF( .NOT.lsamen( 2, c2, 'BD' ) ) THEN
551  IF( ok ) THEN
552  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
553  $ nt
554  ELSE
555  WRITE( nout, fmt = 9998 )
556  END IF
557  END IF
558 *
559  9999 FORMAT( 1x, a, ' passed the tests of the error exits (', i3,
560  $ ' tests done)' )
561  9998 FORMAT( ' *** ', a, ' failed the tests of the error exits ***' )
562  RETURN
563 *
564 * End of SERRED
565 *
566  END
sgeev
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:193
serred
subroutine serred(PATH, NUNIT)
SERRED
Definition: serred.f:72
sgesdd
subroutine sgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
SGESDD
Definition: sgesdd.f:220
sgees
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 m...
Definition: sgees.f:218
sgejsv
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:478
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
sgesvd
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
sgesvdx
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:265
sgeevx
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:307
sgeesx
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
sgesvdq
subroutine sgesvdq(JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK, WORK, LWORK, RWORK, LRWORK, INFO)
SGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE...
Definition: sgesvdq.f:417