LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cerred.f
Go to the documentation of this file.
1 *> \brief \b CERRED
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 CERRED( 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 *> CERRED tests the error exits for the eigenvalue driver routines for
25 *> REAL matrices:
26 *>
27 *> PATH driver description
28 *> ---- ------ -----------
29 *> CEV CGEEV find eigenvalues/eigenvectors for nonsymmetric A
30 *> CES CGEES find eigenvalues/Schur form for nonsymmetric A
31 *> CVX CGEEVX CGEEV + balancing and condition estimation
32 *> CSX CGEESX CGEES + balancing and condition estimation
33 *> CBD CGESVD compute SVD of an M-by-N matrix A
34 *> CGESDD compute SVD of an M-by-N matrix A(by divide and
35 *> conquer)
36 *> \endverbatim
37 *
38 * Arguments:
39 * ==========
40 *
41 *> \param[in] PATH
42 *> \verbatim
43 *> PATH is CHARACTER*3
44 *> The LAPACK path name for the routines to be tested.
45 *> \endverbatim
46 *>
47 *> \param[in] NUNIT
48 *> \verbatim
49 *> NUNIT is INTEGER
50 *> The unit number for output.
51 *> \endverbatim
52 *
53 * Authors:
54 * ========
55 *
56 *> \author Univ. of Tennessee
57 *> \author Univ. of California Berkeley
58 *> \author Univ. of Colorado Denver
59 *> \author NAG Ltd.
60 *
61 *> \date November 2011
62 *
63 *> \ingroup complex_eig
64 *
65 * =====================================================================
66  SUBROUTINE cerred( PATH, NUNIT )
67 *
68 * -- LAPACK test routine (version 3.4.0) --
69 * -- LAPACK is a software package provided by Univ. of Tennessee, --
70 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
71 * November 2011
72 *
73 * .. Scalar Arguments ..
74  CHARACTER*3 path
75  INTEGER nunit
76 * ..
77 *
78 * =====================================================================
79 *
80 * .. Parameters ..
81  INTEGER nmax, lw
82  parameter( nmax = 4, lw = 5*nmax )
83  REAL one, zero
84  parameter( one = 1.0e0, zero = 0.0e0 )
85 * ..
86 * .. Local Scalars ..
87  CHARACTER*2 c2
88  INTEGER i, ihi, ilo, info, j, nt, sdim
89  REAL abnrm
90 * ..
91 * .. Local Arrays ..
92  LOGICAL b( nmax )
93  INTEGER iw( 4*nmax )
94  REAL r1( nmax ), r2( nmax ), rw( lw ), s( nmax )
95  COMPLEX a( nmax, nmax ), u( nmax, nmax ),
96  $ vl( nmax, nmax ), vr( nmax, nmax ),
97  $ vt( nmax, nmax ), w( 4*nmax ), x( nmax )
98 * ..
99 * .. External Subroutines ..
100  EXTERNAL cgees, cgeesx, cgeev, cgeevx, cgesdd, cgesvd,
101  $ chkxer
102 * ..
103 * .. External Functions ..
104  LOGICAL cslect, lsamen
105  EXTERNAL cslect, lsamen
106 * ..
107 * .. Intrinsic Functions ..
108  INTRINSIC len_trim
109 * ..
110 * .. Arrays in Common ..
111  LOGICAL selval( 20 )
112  REAL selwi( 20 ), selwr( 20 )
113 * ..
114 * .. Scalars in Common ..
115  LOGICAL lerr, ok
116  CHARACTER*32 srnamt
117  INTEGER infot, nout, seldim, selopt
118 * ..
119 * .. Common blocks ..
120  common / infoc / infot, nout, ok, lerr
121  common / srnamc / srnamt
122  common / sslct / selopt, seldim, selval, selwr, selwi
123 * ..
124 * .. Executable Statements ..
125 *
126  nout = nunit
127  WRITE( nout, fmt = * )
128  c2 = path( 2: 3 )
129 *
130 * Initialize A
131 *
132  DO 20 j = 1, nmax
133  DO 10 i = 1, nmax
134  a( i, j ) = zero
135  10 continue
136  20 continue
137  DO 30 i = 1, nmax
138  a( i, i ) = one
139  30 continue
140  ok = .true.
141  nt = 0
142 *
143  IF( lsamen( 2, c2, 'EV' ) ) THEN
144 *
145 * Test CGEEV
146 *
147  srnamt = 'CGEEV '
148  infot = 1
149  CALL cgeev( 'X', 'N', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
150  $ info )
151  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
152  infot = 2
153  CALL cgeev( 'N', 'X', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
154  $ info )
155  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
156  infot = 3
157  CALL cgeev( 'N', 'N', -1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
158  $ info )
159  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
160  infot = 5
161  CALL cgeev( 'N', 'N', 2, a, 1, x, vl, 1, vr, 1, w, 4, rw,
162  $ info )
163  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
164  infot = 8
165  CALL cgeev( 'V', 'N', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
166  $ info )
167  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
168  infot = 10
169  CALL cgeev( 'N', 'V', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
170  $ info )
171  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
172  infot = 12
173  CALL cgeev( 'V', 'V', 1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
174  $ info )
175  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
176  nt = nt + 7
177 *
178  ELSE IF( lsamen( 2, c2, 'ES' ) ) THEN
179 *
180 * Test CGEES
181 *
182  srnamt = 'CGEES '
183  infot = 1
184  CALL cgees( 'X', 'N', cslect, 0, a, 1, sdim, x, vl, 1, w, 1,
185  $ rw, b, info )
186  CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
187  infot = 2
188  CALL cgees( 'N', 'X', cslect, 0, a, 1, sdim, x, vl, 1, w, 1,
189  $ rw, b, info )
190  CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
191  infot = 4
192  CALL cgees( 'N', 'S', cslect, -1, a, 1, sdim, x, vl, 1, w, 1,
193  $ rw, b, info )
194  CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
195  infot = 6
196  CALL cgees( 'N', 'S', cslect, 2, a, 1, sdim, x, vl, 1, w, 4,
197  $ rw, b, info )
198  CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
199  infot = 10
200  CALL cgees( 'V', 'S', cslect, 2, a, 2, sdim, x, vl, 1, w, 4,
201  $ rw, b, info )
202  CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
203  infot = 12
204  CALL cgees( 'N', 'S', cslect, 1, a, 1, sdim, x, vl, 1, w, 1,
205  $ rw, b, info )
206  CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
207  nt = nt + 6
208 *
209  ELSE IF( lsamen( 2, c2, 'VX' ) ) THEN
210 *
211 * Test CGEEVX
212 *
213  srnamt = 'CGEEVX'
214  infot = 1
215  CALL cgeevx( 'X', 'N', 'N', 'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
216  $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
217  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
218  infot = 2
219  CALL cgeevx( 'N', 'X', 'N', 'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
220  $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
221  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
222  infot = 3
223  CALL cgeevx( 'N', 'N', 'X', 'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
224  $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
225  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
226  infot = 4
227  CALL cgeevx( 'N', 'N', 'N', 'X', 0, a, 1, x, vl, 1, vr, 1, ilo,
228  $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
229  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
230  infot = 5
231  CALL cgeevx( 'N', 'N', 'N', 'N', -1, a, 1, x, vl, 1, vr, 1,
232  $ ilo, ihi, s, abnrm, r1, r2, w, 1, rw, info )
233  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
234  infot = 7
235  CALL cgeevx( 'N', 'N', 'N', 'N', 2, a, 1, x, vl, 1, vr, 1, ilo,
236  $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
237  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
238  infot = 10
239  CALL cgeevx( 'N', 'V', 'N', 'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
240  $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
241  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
242  infot = 12
243  CALL cgeevx( 'N', 'N', 'V', 'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
244  $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
245  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
246  infot = 20
247  CALL cgeevx( 'N', 'N', 'N', 'N', 1, a, 1, x, vl, 1, vr, 1, ilo,
248  $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
249  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
250  infot = 20
251  CALL cgeevx( 'N', 'N', 'V', 'V', 1, a, 1, x, vl, 1, vr, 1, ilo,
252  $ ihi, s, abnrm, r1, r2, w, 2, rw, info )
253  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
254  nt = nt + 10
255 *
256  ELSE IF( lsamen( 2, c2, 'SX' ) ) THEN
257 *
258 * Test CGEESX
259 *
260  srnamt = 'CGEESX'
261  infot = 1
262  CALL cgeesx( 'X', 'N', cslect, 'N', 0, a, 1, sdim, x, vl, 1,
263  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
264  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
265  infot = 2
266  CALL cgeesx( 'N', 'X', cslect, 'N', 0, a, 1, sdim, x, vl, 1,
267  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
268  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
269  infot = 4
270  CALL cgeesx( 'N', 'N', cslect, 'X', 0, a, 1, sdim, x, vl, 1,
271  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
272  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
273  infot = 5
274  CALL cgeesx( 'N', 'N', cslect, 'N', -1, a, 1, sdim, x, vl, 1,
275  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
276  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
277  infot = 7
278  CALL cgeesx( 'N', 'N', cslect, 'N', 2, a, 1, sdim, x, vl, 1,
279  $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
280  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
281  infot = 11
282  CALL cgeesx( 'V', 'N', cslect, 'N', 2, a, 2, sdim, x, vl, 1,
283  $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
284  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
285  infot = 15
286  CALL cgeesx( 'N', 'N', cslect, 'N', 1, a, 1, sdim, x, vl, 1,
287  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
288  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
289  nt = nt + 7
290 *
291  ELSE IF( lsamen( 2, c2, 'BD' ) ) THEN
292 *
293 * Test CGESVD
294 *
295  srnamt = 'CGESVD'
296  infot = 1
297  CALL cgesvd( 'X', 'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
298  $ info )
299  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
300  infot = 2
301  CALL cgesvd( 'N', 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
302  $ info )
303  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
304  infot = 2
305  CALL cgesvd( 'O', 'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
306  $ info )
307  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
308  infot = 3
309  CALL cgesvd( 'N', 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
310  $ info )
311  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
312  infot = 4
313  CALL cgesvd( 'N', 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw,
314  $ info )
315  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
316  infot = 6
317  CALL cgesvd( 'N', 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw,
318  $ info )
319  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
320  infot = 9
321  CALL cgesvd( 'A', 'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw,
322  $ info )
323  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
324  infot = 11
325  CALL cgesvd( 'N', 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw,
326  $ info )
327  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
328  nt = 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 CGESDD
337 *
338  srnamt = 'CGESDD'
339  infot = 1
340  CALL cgesdd( 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
341  $ info )
342  CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
343  infot = 2
344  CALL cgesdd( 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
345  $ info )
346  CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
347  infot = 3
348  CALL cgesdd( 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
349  $ info )
350  CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
351  infot = 5
352  CALL cgesdd( 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
353  $ info )
354  CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
355  infot = 8
356  CALL cgesdd( 'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw, iw,
357  $ info )
358  CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
359  infot = 10
360  CALL cgesdd( 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
361  $ info )
362  CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
363  nt = nt - 2
364  IF( ok ) THEN
365  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
366  $ nt
367  ELSE
368  WRITE( nout, fmt = 9998 )
369  END IF
370  END IF
371 *
372 * Print a summary line.
373 *
374  IF( .NOT.lsamen( 2, c2, 'BD' ) ) THEN
375  IF( ok ) THEN
376  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
377  $ nt
378  ELSE
379  WRITE( nout, fmt = 9998 )
380  END IF
381  END IF
382 *
383  9999 format( 1x, a, ' passed the tests of the error exits (', i3,
384  $ ' tests done)' )
385  9998 format( ' *** ', a, ' failed the tests of the error exits ***' )
386  return
387 *
388 * End of CERRED
389 *
390  END