LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
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
subroutine cgees(JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, LDVS, WORK, LWORK, RWORK, BWORK, INFO)
CGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
Definition: cgees.f:197
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3198
subroutine cgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, INFO)
CGESVD computes the singular value decomposition (SVD) for GE matrices
Definition: cgesvd.f:214
subroutine cerred(PATH, NUNIT)
CERRED
Definition: cerred.f:66
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine cgeesx(JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK, BWORK, INFO)
CGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE...
Definition: cgeesx.f:238
subroutine cgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, IWORK, INFO)
CGESDD
Definition: cgesdd.f:222
ELF f x
Definition: testslamch:1
subroutine cgeev(JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
CGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: cgeev.f:177
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
Definition: xerbla-fortran:9
LOGICAL function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:75
subroutine cgeevx(BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, RWORK, INFO)
CGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: cgeevx.f:284
LOGICAL function cslect(Z)
CSLECT
Definition: cslect.f:57