LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
zerred.f
Go to the documentation of this file.
1 *> \brief \b ZERRED
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 ZERRED( 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 *> ZERRED tests the error exits for the eigenvalue driver routines for
25 *> DOUBLE PRECISION matrices:
26 *>
27 *> PATH driver description
28 *> ---- ------ -----------
29 *> ZEV ZGEEV find eigenvalues/eigenvectors for nonsymmetric A
30 *> ZES ZGEES find eigenvalues/Schur form for nonsymmetric A
31 *> ZVX ZGEEVX ZGEEV + balancing and condition estimation
32 *> ZSX ZGEESX ZGEES + balancing and condition estimation
33 *> ZBD ZGESVD compute SVD of an M-by-N matrix A
34 *> ZGESDD 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 complex16_eig
64 *
65 * =====================================================================
66  SUBROUTINE zerred( 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  DOUBLE PRECISION ONE, ZERO
84  parameter( one = 1.0d0, zero = 0.0d0 )
85 * ..
86 * .. Local Scalars ..
87  CHARACTER*2 C2
88  INTEGER I, IHI, ILO, INFO, J, NT, SDIM
89  DOUBLE PRECISION ABNRM
90 * ..
91 * .. Local Arrays ..
92  LOGICAL B( nmax )
93  INTEGER IW( 4*nmax )
94  DOUBLE PRECISION R1( nmax ), R2( nmax ), RW( lw ), S( nmax )
95  COMPLEX*16 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 chkxer, zgees, zgeesx, zgeev, zgeevx, zgesdd,
101  $ zgesvd
102 * ..
103 * .. External Functions ..
104  LOGICAL LSAMEN, ZSLECT
105  EXTERNAL lsamen, zslect
106 * ..
107 * .. Intrinsic Functions ..
108  INTRINSIC len_trim
109 * ..
110 * .. Arrays in Common ..
111  LOGICAL SELVAL( 20 )
112  DOUBLE PRECISION 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 ZGEEV
146 *
147  srnamt = 'ZGEEV '
148  infot = 1
149  CALL zgeev( 'X', 'N', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
150  $ info )
151  CALL chkxer( 'ZGEEV ', infot, nout, lerr, ok )
152  infot = 2
153  CALL zgeev( 'N', 'X', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
154  $ info )
155  CALL chkxer( 'ZGEEV ', infot, nout, lerr, ok )
156  infot = 3
157  CALL zgeev( 'N', 'N', -1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
158  $ info )
159  CALL chkxer( 'ZGEEV ', infot, nout, lerr, ok )
160  infot = 5
161  CALL zgeev( 'N', 'N', 2, a, 1, x, vl, 1, vr, 1, w, 4, rw,
162  $ info )
163  CALL chkxer( 'ZGEEV ', infot, nout, lerr, ok )
164  infot = 8
165  CALL zgeev( 'V', 'N', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
166  $ info )
167  CALL chkxer( 'ZGEEV ', infot, nout, lerr, ok )
168  infot = 10
169  CALL zgeev( 'N', 'V', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
170  $ info )
171  CALL chkxer( 'ZGEEV ', infot, nout, lerr, ok )
172  infot = 12
173  CALL zgeev( 'V', 'V', 1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
174  $ info )
175  CALL chkxer( 'ZGEEV ', infot, nout, lerr, ok )
176  nt = nt + 7
177 *
178  ELSE IF( lsamen( 2, c2, 'ES' ) ) THEN
179 *
180 * Test ZGEES
181 *
182  srnamt = 'ZGEES '
183  infot = 1
184  CALL zgees( 'X', 'N', zslect, 0, a, 1, sdim, x, vl, 1, w, 1,
185  $ rw, b, info )
186  CALL chkxer( 'ZGEES ', infot, nout, lerr, ok )
187  infot = 2
188  CALL zgees( 'N', 'X', zslect, 0, a, 1, sdim, x, vl, 1, w, 1,
189  $ rw, b, info )
190  CALL chkxer( 'ZGEES ', infot, nout, lerr, ok )
191  infot = 4
192  CALL zgees( 'N', 'S', zslect, -1, a, 1, sdim, x, vl, 1, w, 1,
193  $ rw, b, info )
194  CALL chkxer( 'ZGEES ', infot, nout, lerr, ok )
195  infot = 6
196  CALL zgees( 'N', 'S', zslect, 2, a, 1, sdim, x, vl, 1, w, 4,
197  $ rw, b, info )
198  CALL chkxer( 'ZGEES ', infot, nout, lerr, ok )
199  infot = 10
200  CALL zgees( 'V', 'S', zslect, 2, a, 2, sdim, x, vl, 1, w, 4,
201  $ rw, b, info )
202  CALL chkxer( 'ZGEES ', infot, nout, lerr, ok )
203  infot = 12
204  CALL zgees( 'N', 'S', zslect, 1, a, 1, sdim, x, vl, 1, w, 1,
205  $ rw, b, info )
206  CALL chkxer( 'ZGEES ', infot, nout, lerr, ok )
207  nt = nt + 6
208 *
209  ELSE IF( lsamen( 2, c2, 'VX' ) ) THEN
210 *
211 * Test ZGEEVX
212 *
213  srnamt = 'ZGEEVX'
214  infot = 1
215  CALL zgeevx( '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( 'ZGEEVX', infot, nout, lerr, ok )
218  infot = 2
219  CALL zgeevx( '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( 'ZGEEVX', infot, nout, lerr, ok )
222  infot = 3
223  CALL zgeevx( '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( 'ZGEEVX', infot, nout, lerr, ok )
226  infot = 4
227  CALL zgeevx( '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( 'ZGEEVX', infot, nout, lerr, ok )
230  infot = 5
231  CALL zgeevx( '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( 'ZGEEVX', infot, nout, lerr, ok )
234  infot = 7
235  CALL zgeevx( '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( 'ZGEEVX', infot, nout, lerr, ok )
238  infot = 10
239  CALL zgeevx( '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( 'ZGEEVX', infot, nout, lerr, ok )
242  infot = 12
243  CALL zgeevx( '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( 'ZGEEVX', infot, nout, lerr, ok )
246  infot = 20
247  CALL zgeevx( '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( 'ZGEEVX', infot, nout, lerr, ok )
250  infot = 20
251  CALL zgeevx( '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( 'ZGEEVX', infot, nout, lerr, ok )
254  nt = nt + 10
255 *
256  ELSE IF( lsamen( 2, c2, 'SX' ) ) THEN
257 *
258 * Test ZGEESX
259 *
260  srnamt = 'ZGEESX'
261  infot = 1
262  CALL zgeesx( 'X', 'N', zslect, 'N', 0, a, 1, sdim, x, vl, 1,
263  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
264  CALL chkxer( 'ZGEESX', infot, nout, lerr, ok )
265  infot = 2
266  CALL zgeesx( 'N', 'X', zslect, 'N', 0, a, 1, sdim, x, vl, 1,
267  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
268  CALL chkxer( 'ZGEESX', infot, nout, lerr, ok )
269  infot = 4
270  CALL zgeesx( 'N', 'N', zslect, 'X', 0, a, 1, sdim, x, vl, 1,
271  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
272  CALL chkxer( 'ZGEESX', infot, nout, lerr, ok )
273  infot = 5
274  CALL zgeesx( 'N', 'N', zslect, 'N', -1, a, 1, sdim, x, vl, 1,
275  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
276  CALL chkxer( 'ZGEESX', infot, nout, lerr, ok )
277  infot = 7
278  CALL zgeesx( 'N', 'N', zslect, 'N', 2, a, 1, sdim, x, vl, 1,
279  $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
280  CALL chkxer( 'ZGEESX', infot, nout, lerr, ok )
281  infot = 11
282  CALL zgeesx( 'V', 'N', zslect, 'N', 2, a, 2, sdim, x, vl, 1,
283  $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
284  CALL chkxer( 'ZGEESX', infot, nout, lerr, ok )
285  infot = 15
286  CALL zgeesx( 'N', 'N', zslect, 'N', 1, a, 1, sdim, x, vl, 1,
287  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
288  CALL chkxer( 'ZGEESX', infot, nout, lerr, ok )
289  nt = nt + 7
290 *
291  ELSE IF( lsamen( 2, c2, 'BD' ) ) THEN
292 *
293 * Test ZGESVD
294 *
295  srnamt = 'ZGESVD'
296  infot = 1
297  CALL zgesvd( 'X', 'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
298  $ info )
299  CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
300  infot = 2
301  CALL zgesvd( 'N', 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
302  $ info )
303  CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
304  infot = 2
305  CALL zgesvd( 'O', 'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
306  $ info )
307  CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
308  infot = 3
309  CALL zgesvd( 'N', 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
310  $ info )
311  CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
312  infot = 4
313  CALL zgesvd( 'N', 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw,
314  $ info )
315  CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
316  infot = 6
317  CALL zgesvd( 'N', 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw,
318  $ info )
319  CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
320  infot = 9
321  CALL zgesvd( 'A', 'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw,
322  $ info )
323  CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
324  infot = 11
325  CALL zgesvd( 'N', 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw,
326  $ info )
327  CALL chkxer( 'ZGESVD', 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 ZGESDD
337 *
338  srnamt = 'ZGESDD'
339  infot = 1
340  CALL zgesdd( 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
341  $ info )
342  CALL chkxer( 'ZGESDD', infot, nout, lerr, ok )
343  infot = 2
344  CALL zgesdd( 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
345  $ info )
346  CALL chkxer( 'ZGESDD', infot, nout, lerr, ok )
347  infot = 3
348  CALL zgesdd( 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
349  $ info )
350  CALL chkxer( 'ZGESDD', infot, nout, lerr, ok )
351  infot = 5
352  CALL zgesdd( 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
353  $ info )
354  CALL chkxer( 'ZGESDD', infot, nout, lerr, ok )
355  infot = 8
356  CALL zgesdd( 'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw, iw,
357  $ info )
358  CALL chkxer( 'ZGESDD', infot, nout, lerr, ok )
359  infot = 10
360  CALL zgesdd( 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
361  $ info )
362  CALL chkxer( 'ZGESDD', 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 ZERRED
389 *
390  END
subroutine zgees(JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, LDVS, WORK, LWORK, RWORK, BWORK, INFO)
ZGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
Definition: zgees.f:199
subroutine zgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, IWORK, INFO)
ZGESDD
Definition: zgesdd.f:224
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine zgeev(JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
ZGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: zgeev.f:179
subroutine zgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, INFO)
ZGESVD computes the singular value decomposition (SVD) for GE matrices
Definition: zgesvd.f:216
subroutine zgeevx(BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, RWORK, INFO)
ZGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: zgeevx.f:287
subroutine zerred(PATH, NUNIT)
ZERRED
Definition: zerred.f:67
subroutine zgeesx(JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK, BWORK, INFO)
ZGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE...
Definition: zgeesx.f:241