OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
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 COMPLEX 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*> ZGEJSV compute SVD of an M-by-N matrix A where M >= N
37*> ZGESVDX compute SVD of an M-by-N matrix A(by bisection
38*> and inverse iteration)
39*> ZGESVDQ 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 complex16_eig
67*
68* =====================================================================
69 SUBROUTINE zerred( 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, LW
84 parameter( nmax = 4, lw = 5*nmax )
85 DOUBLE PRECISION ONE, ZERO
86 parameter( one = 1.0d0, zero = 0.0d0 )
87* ..
88* .. Local Scalars ..
89 CHARACTER*2 C2
90 INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
91 DOUBLE PRECISION ABNRM
92* ..
93* .. Local Arrays ..
94 LOGICAL B( NMAX )
95 INTEGER IW( 4*NMAX )
96 DOUBLE PRECISION R1( NMAX ), R2( NMAX ), RW( LW ), S( NMAX )
97 COMPLEX*16 A( NMAX, NMAX ), U( NMAX, NMAX ),
98 $ VL( NMAX, NMAX ), VR( NMAX, NMAX ),
99 $ VT( NMAX, NMAX ), W( 10*NMAX ), X( NMAX )
100* ..
101* .. External Subroutines ..
102 EXTERNAL chkxer, zgees, zgeesx, zgeev, zgeevx, zgesvj,
103 $ zgesdd, zgesvd, zgesvdx, zgesvq
104* ..
105* .. External Functions ..
106 LOGICAL LSAMEN, ZSLECT
107 EXTERNAL lsamen, zslect
108* ..
109* .. Intrinsic Functions ..
110 INTRINSIC len_trim
111* ..
112* .. Arrays in Common ..
113 LOGICAL SELVAL( 20 )
114 DOUBLE PRECISION SELWI( 20 ), SELWR( 20 )
115* ..
116* .. Scalars in Common ..
117 LOGICAL LERR, OK
118 CHARACTER*32 SRNAMT
119 INTEGER INFOT, NOUT, SELDIM, SELOPT
120* ..
121* .. Common blocks ..
122 COMMON / infoc / infot, nout, ok, lerr
123 COMMON / srnamc / srnamt
124 COMMON / sslct / selopt, seldim, selval, selwr, selwi
125* ..
126* .. Executable Statements ..
127*
128 nout = nunit
129 WRITE( nout, fmt = * )
130 c2 = path( 2: 3 )
131*
132* Initialize A
133*
134 DO 20 j = 1, nmax
135 DO 10 i = 1, nmax
136 a( i, j ) = zero
137 10 CONTINUE
138 20 CONTINUE
139 DO 30 i = 1, nmax
140 a( i, i ) = one
141 30 CONTINUE
142 ok = .true.
143 nt = 0
144*
145 IF( lsamen( 2, c2, 'EV' ) ) THEN
146*
147* Test ZGEEV
148*
149 srnamt = 'ZGEEV '
150 infot = 1
151 CALL zgeev( 'X', 'N', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
152 $ info )
153 CALL chkxer( 'ZGEEV ', infot, nout, lerr, ok )
154 infot = 2
155 CALL zgeev( 'N', 'X', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
156 $ info )
157 CALL chkxer( 'ZGEEV ', infot, nout, lerr, ok )
158 infot = 3
159 CALL zgeev( 'N', 'N', -1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
160 $ info )
161 CALL chkxer( 'ZGEEV ', infot, nout, lerr, ok )
162 infot = 5
163 CALL zgeev( 'N', 'N', 2, a, 1, x, vl, 1, vr, 1, w, 4, rw,
164 $ info )
165 CALL chkxer( 'ZGEEV ', infot, nout, lerr, ok )
166 infot = 8
167 CALL zgeev( 'V', 'n', 2, A, 2, X, VL, 1, VR, 1, W, 4, RW,
168 $ INFO )
169 CALL CHKXER( 'zgeev ', INFOT, NOUT, LERR, OK )
170 INFOT = 10
171 CALL ZGEEV( 'n', 'v', 2, A, 2, X, VL, 1, VR, 1, W, 4, RW,
172 $ INFO )
173 CALL CHKXER( 'zgeev ', INFOT, NOUT, LERR, OK )
174 INFOT = 12
175 CALL ZGEEV( 'v', 'v', 1, A, 1, X, VL, 1, VR, 1, W, 1, RW,
176 $ INFO )
177 CALL CHKXER( 'zgeev ', INFOT, NOUT, LERR, OK )
178 NT = NT + 7
179*
180 ELSE IF( LSAMEN( 2, C2, 'es' ) ) THEN
181*
182* Test ZGEES
183*
184 SRNAMT = 'zgees '
185 INFOT = 1
186 CALL ZGEES( 'x', 'n', ZSLECT, 0, A, 1, SDIM, X, VL, 1, W, 1,
187 $ RW, B, INFO )
188 CALL CHKXER( 'zgees ', INFOT, NOUT, LERR, OK )
189 INFOT = 2
190 CALL ZGEES( 'n', 'x', ZSLECT, 0, A, 1, SDIM, X, VL, 1, W, 1,
191 $ RW, B, INFO )
192 CALL CHKXER( 'zgees ', INFOT, NOUT, LERR, OK )
193 INFOT = 4
194 CALL ZGEES( 'n', 's', ZSLECT, -1, A, 1, SDIM, X, VL, 1, W, 1,
195 $ RW, B, INFO )
196 CALL CHKXER( 'zgees ', infot, nout, lerr, ok )
197 infot = 6
198 CALL zgees( 'n', 's', ZSLECT, 2, A, 1, SDIM, X, VL, 1, W, 4,
199 $ RW, B, INFO )
200 CALL CHKXER( 'zgees ', INFOT, NOUT, LERR, OK )
201 INFOT = 10
202 CALL ZGEES( 'v', 's', ZSLECT, 2, A, 2, SDIM, X, VL, 1, W, 4,
203 $ RW, B, INFO )
204 CALL CHKXER( 'zgees ', INFOT, NOUT, LERR, OK )
205 INFOT = 12
206 CALL ZGEES( 'n', 's', ZSLECT, 1, A, 1, SDIM, X, VL, 1, W, 1,
207 $ RW, B, INFO )
208 CALL CHKXER( 'zgees ', INFOT, NOUT, LERR, OK )
209 NT = NT + 6
210*
211 ELSE IF( LSAMEN( 2, C2, 'vx' ) ) THEN
212*
213* Test ZGEEVX
214*
215 SRNAMT = 'zgeevx'
216 INFOT = 1
217 CALL ZGEEVX( 'x', 'n', 'n', 'n', 0, a, 1, x, vl, 1, vr, 1, ilo,
218 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
219 CALL chkxer( 'ZGEEVX', infot, nout, lerr, ok )
220 infot = 2
221 CALL zgeevx( 'N', 'X', 'N', 'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
222 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
223 CALL chkxer( 'ZGEEVX', infot, nout, lerr, ok )
224 infot = 3
225 CALL zgeevx( 'N', 'N', 'X', 'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
226 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
227 CALL chkxer( 'ZGEEVX', infot, nout, lerr, ok )
228 infot = 4
229 CALL zgeevx( 'N', 'N', 'N', 'X', 0, a, 1, x, vl, 1, vr, 1, ilo,
230 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
231 CALL chkxer( 'zgeevx', INFOT, NOUT, LERR, OK )
232 INFOT = 5
233 CALL ZGEEVX( 'n', 'n', 'n', 'n', -1, A, 1, X, VL, 1, VR, 1,
234 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
235 CALL CHKXER( 'zgeevx', INFOT, NOUT, LERR, OK )
236 INFOT = 7
237 CALL ZGEEVX( 'n', 'N', 'N', 'N', 2, a, 1, x, vl, 1, vr, 1, ilo,
238 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
239 CALL chkxer( 'ZGEEVX', infot, nout, lerr, ok )
240 infot = 10
241 CALL zgeevx( 'N', 'V', 'N', 'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
242 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
243 CALL chkxer( 'ZGEEVX', infot, nout, lerr, ok )
244 infot = 12
245 CALL zgeevx( 'N', 'N', 'V', 'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
246 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
247 CALL chkxer( 'ZGEEVX', infot, nout, lerr, ok )
248 infot = 20
249 CALL zgeevx( 'N', 'N', 'N', 'N', 1, a, 1, x, vl, 1, vr, 1, ilo,
250 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
251 CALL chkxer( 'ZGEEVX', infot, nout, lerr, ok )
252 infot = 20
253 CALL zgeevx( 'N', 'N', 'V', 'V', 1, a, 1, x, vl, 1, vr, 1, ilo,
254 $ ihi, s, abnrm, r1, r2, w, 2, rw, info )
255 CALL chkxer( 'ZGEEVX', infot, nout, lerr, ok )
256 nt = nt + 10
257*
258 ELSE IF( lsamen( 2, c2, 'SX' ) ) THEN
259*
260* Test ZGEESX
261*
262 srnamt = 'ZGEESX'
263 infot = 1
264 CALL zgeesx( 'X', 'N', zslect, 'N', 0, a, 1, sdim, x, vl, 1,
265 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
266 CALL chkxer( 'ZGEESX', infot, nout, lerr, ok )
267 infot = 2
268 CALL zgeesx( 'N', 'X', zslect, 'N', 0, a, 1, sdim, x, vl, 1,
269 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
270 CALL chkxer( 'ZGEESX', infot, nout, lerr, ok )
271 infot = 4
272 CALL zgeesx( 'N', 'N', zslect, 'X', 0, a, 1, sdim, x, vl, 1,
273 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
274 CALL chkxer( 'ZGEESX', infot, nout, lerr, ok )
275 infot = 5
276 CALL zgeesx( 'N', 'N', zslect, 'N', -1, a, 1, sdim, x, vl, 1,
277 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
278 CALL chkxer( 'ZGEESX', infot, nout, lerr, ok )
279 infot = 7
280 CALL zgeesx( 'N', 'N', zslect, 'N', 2, a, 1, sdim, x, vl, 1,
281 $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
282 CALL chkxer( 'ZGEESX', infot, nout, lerr, ok )
283 infot = 11
284 CALL zgeesx( 'V', 'N', zslect, 'n', 2, A, 2, SDIM, X, VL, 1,
285 $ R1( 1 ), R2( 1 ), W, 4, RW, B, INFO )
286 CALL CHKXER( 'zgeesx', INFOT, NOUT, LERR, OK )
287 INFOT = 15
288 CALL ZGEESX( 'n', 'n', ZSLECT, 'n', 1, A, 1, SDIM, X, VL, 1,
289 $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
290 CALL CHKXER( 'zgeesx', INFOT, NOUT, LERR, OK )
291 NT = NT + 7
292*
293 ELSE IF( LSAMEN( 2, C2, 'bd' ) ) THEN
294*
295* Test ZGESVD
296*
297 SRNAMT = 'zgesvd'
298 INFOT = 1
299 CALL ZGESVD( 'x', 'n', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
300 $ info )
301 CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
302 infot = 2
303 CALL zgesvd( 'N', 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
304 $ info )
305 CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
306 infot = 2
307 CALL zgesvd( 'O', 'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
308 $ info )
309 CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
310 infot = 3
311 CALL zgesvd( 'N', 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
312 $ info )
313 CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
314 infot = 4
315 CALL zgesvd( 'N', 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw,
316 $ info )
317 CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
318 infot = 6
319 CALL zgesvd( 'N', 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw,
320 $ info )
321 CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
322 infot = 9
323 CALL zgesvd( 'A', 'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw,
324 $ info )
325 CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
326 infot = 11
327 CALL zgesvd( 'N', 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw,
328 $ info )
329 CALL chkxer( 'ZGESVD', infot, nout, lerr, ok )
330 nt = 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 ZGESDD
339*
340 srnamt = 'ZGESDD'
341 infot = 1
342 CALL zgesdd( 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
343 $ info )
344 CALL chkxer( 'ZGESDD', infot, nout, lerr, ok )
345 infot = 2
346 CALL zgesdd( 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
347 $ info )
348 CALL chkxer( 'ZGESDD', infot, nout, lerr, ok )
349 infot = 3
350 CALL zgesdd( 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
351 $ info )
352 CALL chkxer( 'zgesdd', INFOT, NOUT, LERR, OK )
353 INFOT = 5
354 CALL ZGESDD( 'n', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, RW, IW,
355 $ INFO )
356 CALL CHKXER( 'zgesdd', INFOT, NOUT, LERR, OK )
357 INFOT = 8
358 CALL ZGESDD( 'a', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, RW, IW,
359 $ INFO )
360 CALL CHKXER( 'zgesdd', INFOT, NOUT, LERR, OK )
361 INFOT = 10
362 CALL ZGESDD( 'a', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, RW, IW,
363 $ INFO )
364 CALL CHKXER( 'zgesdd', INFOT, NOUT, LERR, OK )
365 NT = NT - 2
366 IF( OK ) THEN
367 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
368 $ NT
369 ELSE
370 WRITE( NOUT, FMT = 9998 )
371 END IF
372*
373* Test ZGEJSV
374*
375 SRNAMT = 'zgejsv'
376 INFOT = 1
377 CALL ZGEJSV( 'x', 'u', 'v', 'r', 'n', 'n',
378 $ 0, 0, A, 1, S, U, 1, VT, 1,
379 $ W, 1, RW, 1, IW, INFO)
380 CALL CHKXER( 'zgejsv', INFOT, NOUT, LERR, OK )
381 INFOT = 2
382 CALL ZGEJSV( 'g', 'x', 'v', 'r', 'n', 'n',
383 $ 0, 0, A, 1, S, U, 1, VT, 1,
384 $ W, 1, RW, 1, IW, INFO)
385 CALL CHKXER( 'zgejsv', INFOT, NOUT, LERR, OK )
386 INFOT = 3
387 CALL ZGEJSV( 'g', 'u', 'x', 'r', 'n', 'n',
388 $ 0, 0, A, 1, S, U, 1, VT, 1,
389 $ W, 1, RW, 1, IW, INFO)
390 CALL CHKXER( 'zgejsv', INFOT, NOUT, LERR, OK )
391 INFOT = 4
392 CALL ZGEJSV( 'g', 'u', 'v', 'x', 'n', 'n',
393 $ 0, 0, A, 1, S, U, 1, VT, 1,
394 $ W, 1, RW, 1, IW, INFO)
395 CALL CHKXER( 'zgejsv', INFOT, NOUT, LERR, OK )
396 INFOT = 5
397 CALL ZGEJSV( 'g', 'u', 'v', 'r', 'x', 'n',
398 $ 0, 0, A, 1, S, U, 1, VT, 1,
399 $ W, 1, RW, 1, IW, INFO)
400 CALL CHKXER( 'zgejsv', INFOT, NOUT, LERR, OK )
401 INFOT = 6
402 CALL ZGEJSV( 'g', 'u', 'v', 'r', 'n', 'x',
403 $ 0, 0, A, 1, S, U, 1, VT, 1,
404 $ W, 1, RW, 1, IW, INFO)
405 CALL CHKXER( 'zgejsv', INFOT, NOUT, LERR, OK )
406 INFOT = 7
407 CALL ZGEJSV( 'g', 'u', 'v', 'r', 'n', 'n',
408 $ -1, 0, A, 1, S, U, 1, VT, 1,
409 $ W, 1, RW, 1, IW, INFO)
410 CALL CHKXER( 'zgejsv', INFOT, NOUT, LERR, OK )
411 INFOT = 8
412 CALL ZGEJSV( 'g', 'u', 'v', 'r', 'n', 'n',
413 $ 0, -1, A, 1, S, U, 1, VT, 1,
414 $ W, 1, RW, 1, IW, INFO)
415 CALL CHKXER( 'zgejsv', INFOT, NOUT, LERR, OK )
416 INFOT = 10
417 CALL ZGEJSV( 'g', 'u', 'v', 'r', 'N', 'N',
418 $ 2, 1, a, 1, s, u, 1, vt, 1,
419 $ w, 1, rw, 1, iw, info)
420 CALL chkxer( 'ZGEJSV', infot, nout, lerr, ok )
421 infot = 13
422 CALL zgejsv( 'G', 'u', 'v', 'r', 'n', 'n',
423 $ 2, 2, A, 2, S, U, 1, VT, 2,
424 $ W, 1, RW, 1, IW, INFO)
425 CALL CHKXER( 'zgejsv', infot, nout, lerr, ok )
426 infot = 15
427 CALL zgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
428 $ 2, 2, a, 2, s, u, 2, vt, 1,
429 $ w, 1, rw, 1, iw, info)
430 CALL chkxer( 'ZGEJSV', infot, nout, lerr, ok )
431 nt = 11
432 IF( ok ) THEN
433 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
434 $ nt
435 ELSE
436 WRITE( nout, fmt = 9998 )
437 END IF
438*
439* Test ZGESVDX
440*
441 srnamt = 'ZGESVDX'
442 infot = 1
443 CALL zgesvdx( 'X', 'N', 'A', 0, 0, a, 1, zero, zero,
444 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
445 CALL chkxer( 'ZGESVDX', infot, nout, lerr, ok )
446 infot = 2
447 CALL zgesvdx( 'N', 'X', 'A', 0, 0, a, 1, zero, zero,
448 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
449 CALL chkxer( 'ZGESVDX', infot, nout, lerr, ok )
450 infot = 3
451 CALL zgesvdx( 'N', 'N', 'X', 0, 0, a, 1, zero, zero,
452 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
453 CALL chkxer( 'ZGESVDX', infot, nout, lerr, ok )
454 infot = 4
455 CALL zgesvdx( 'N', 'N', 'A', -1, 0, a, 1, zero, zero,
456 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
457 CALL chkxer( 'ZGESVDX', infot, nout, lerr, ok )
458 infot = 5
459 CALL zgesvdx( 'N', 'N', 'A', 0, -1, a, 1, zero, zero,
460 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
461 CALL chkxer( 'ZGESVDX', infot, nout, lerr, ok )
462 infot = 7
463 CALL zgesvdx( 'N', 'N', 'A', 2, 1, a, 1, zero, zero,
464 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
465 CALL chkxer( 'ZGESVDX', infot, nout, lerr, ok )
466 infot = 8
467 CALL zgesvdx( 'N', 'N', 'V', 2, 1, a, 2, -one, zero,
468 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
469 CALL chkxer( 'ZGESVDX', infot, nout, lerr, ok )
470 infot = 9
471 CALL zgesvdx( 'N', 'N', 'V', 2, 1, a, 2, one, zero,
472 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
473 CALL chkxer( 'ZGESVDX', infot, nout, lerr, ok )
474 infot = 10
475 CALL zgesvdx( 'N', 'N', 'I', 2, 2, a, 2, zero, zero,
476 $ 0, 1, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
477 CALL chkxer( 'ZGESVDX', infot, nout, lerr, ok )
478 infot = 11
479 CALL zgesvdx( 'V', 'N', 'I', 2, 2, a, 2, zero, zero,
480 $ 1, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
481 CALL chkxer( 'ZGESVDX', infot, nout, lerr, ok )
482 infot = 15
483 CALL zgesvdx( 'V', 'N', 'A', 2, 2, a, 2, zero, zero,
484 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
485 CALL chkxer( 'ZGESVDX', infot, nout, lerr, ok )
486 infot = 17
487 CALL zgesvdx( 'N', 'V', 'A', 2, 2, a, 2, zero, zero,
488 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
489 CALL chkxer( 'ZGESVDX', infot, nout, lerr, ok )
490 nt = 12
491 IF( ok ) THEN
492 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
493 $ nt
494 ELSE
495 WRITE( nout, fmt = 9998 )
496 END IF
497*
498* Test ZGESVDQ
499*
500 srnamt = 'ZGESVDQ'
501 infot = 1
502 CALL zgesvdq( 'X', 'P', 'T', 'A', 'A', 0, 0, a, 1, s, u,
503 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
504 CALL chkxer( 'ZGESVDQ', infot, nout, lerr, ok )
505 infot = 2
506 CALL zgesvdq( 'A', 'X', 'T', 'A', 'A', 0, 0, a, 1, s, u,
507 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
508 CALL chkxer( 'ZGESVDQ', infot, nout, lerr, ok )
509 infot = 3
510 CALL zgesvdq( 'A', 'P', 'X', 'a', 'a', 0, 0, A, 1, S, U,
511 $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
512 CALL CHKXER( 'zgesvdq', INFOT, NOUT, LERR, OK )
513 INFOT = 4
514 CALL ZGESVDQ( 'a', 'p', 't', 'x', 'a', 0, 0, A, 1, S, U,
515 $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
516 CALL CHKXER( 'zgesvdq', INFOT, NOUT, LERR, OK )
517 INFOT = 5
518 CALL ZGESVDQ( 'a', 'p', 't', 'a', 'x', 0, 0, A, 1, S, U,
519 $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
520 CALL CHKXER( 'zgesvdq', INFOT, NOUT, LERR, OK )
521 INFOT = 6
522 CALL ZGESVDQ( 'a', 'p', 't', 'a', 'a', -1, 0, A, 1, S, U,
523 $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
524 CALL CHKXER( 'zgesvdq', INFOT, NOUT, LERR, OK )
525 INFOT = 7
526 CALL ZGESVDQ( 'a', 'p', 't', 'a', 'a', 0, 1, A, 1, S, U,
527 $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
528 CALL CHKXER( 'zgesvdq', INFOT, NOUT, LERR, OK )
529 INFOT = 9
530 CALL ZGESVDQ( 'a', 'p', 't', 'a', 'a', 1, 1, A, 0, S, U,
531 $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
532 CALL CHKXER( 'zgesvdq', INFOT, NOUT, LERR, OK )
533 INFOT = 12
534 CALL ZGESVDQ( 'a', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
535 $ -1, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
536 CALL chkxer( 'ZGESVDQ', infot, nout, lerr, ok )
537 infot = 14
538 CALL zgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
539 $ 1, vt, -1, ns, iw, 1, w, 1, rw, 1, info )
540 CALL chkxer( 'ZGESVDQ', infot, nout, lerr, ok )
541 infot = 17
542 CALL zgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
543 $ 1, vt, 1, ns, iw, -5, w, 1, rw, 1, info )
544 CALL chkxer( 'ZGESVDQ', infot, nout, lerr, ok )
545 nt = 11
546 IF( ok ) THEN
547 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
548 $ nt
549 ELSE
550 WRITE( nout, fmt = 9998 )
551 END IF
552 END IF
553*
554* Print a summary line.
555*
556 IF( .NOT.lsamen( 2, c2, 'BD' ) ) THEN
557 IF( ok ) THEN
558 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
559 $ nt
560 ELSE
561 WRITE( nout, fmt = 9998 )
562 END IF
563 END IF
564*
565 9999 FORMAT( 1x, a, ' passed the tests of the error exits (', i3,
566 $ ' tests done)' )
567 9998 FORMAT( ' *** ', a, ' failed the tests of the error exits ***' )
568 RETURN
569*
570* End of ZERRED
571*
572 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
zgesvj
subroutine zgesvj(joba, jobu, jobv, m, n, a, lda, sva, mv, v, ldv, cwork, lwork, rwork, lrwork, info)
ZGESVJ
Definition zgesvj.f:351
zgeesx
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:239
zgeev
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:180
zgees
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 m...
Definition zgees.f:197
zgeevx
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:288
zgesdd
subroutine zgesdd(jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, rwork, iwork, info)
ZGESDD
Definition zgesdd.f:227
zgesvdx
subroutine zgesvdx(jobu, jobvt, range, m, n, a, lda, vl, vu, il, iu, ns, s, u, ldu, vt, ldvt, work, lwork, rwork, iwork, info)
ZGESVDX computes the singular value decomposition (SVD) for GE matrices
Definition zgesvdx.f:270
zgesvd
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:214
zgejsv
subroutine zgejsv(joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, cwork, lwork, rwork, lrwork, iwork, info)
ZGEJSV
Definition zgejsv.f:569
zgesvdq
subroutine zgesvdq(joba, jobp, jobr, jobu, jobv, m, n, a, lda, s, u, ldu, v, ldv, numrank, iwork, liwork, cwork, lcwork, rwork, lrwork, info)
ZGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE...
Definition zgesvdq.f:413
zerred
subroutine zerred(path, nunit)
ZERRED
Definition zerred.f:70