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