OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
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*> CGEJSV compute SVD of an M-by-N matrix A where M >= N
37*> CGESVDX compute SVD of an M-by-N matrix A(by bisection
38*> and inverse iteration)
39*> CGESVDQ 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 complex_eig
67*
68* =====================================================================
69 SUBROUTINE cerred( 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 REAL ONE, ZERO
86 parameter( one = 1.0e0, zero = 0.0e0 )
87* ..
88* .. Local Scalars ..
89 CHARACTER*2 C2
90 INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
91 REAL ABNRM
92* ..
93* .. Local Arrays ..
94 LOGICAL B( NMAX )
95 INTEGER IW( 4*NMAX )
96 REAL R1( NMAX ), R2( NMAX ), RW( LW ), S( NMAX )
97 COMPLEX 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, cgees, cgeesx, cgeev, cgeevx, cgejsv,
103 $ cgesdd, cgesvd, cgesvdx, cgesvdq
104* ..
105* .. External Functions ..
106 LOGICAL LSAMEN, CSLECT
107 EXTERNAL lsamen, cslect
108* ..
109* .. Intrinsic Functions ..
110 INTRINSIC len_trim
111* ..
112* .. Arrays in Common ..
113 LOGICAL SELVAL( 20 )
114 REAL 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 CGEEV
148*
149 srnamt = 'CGEEV '
150 infot = 1
151 CALL cgeev( 'X', 'N', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
152 $ info )
153 CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
154 infot = 2
155 CALL cgeev( 'N', 'X', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
156 $ info )
157 CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
158 infot = 3
159 CALL cgeev( 'N', 'N', -1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
160 $ info )
161 CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
162 infot = 5
163 CALL cgeev( 'N', 'N', 2, a, 1, x, vl, 1, vr, 1, w, 4, rw,
164 $ info )
165 CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
166 infot = 8
167 CALL cgeev( 'V', 'N', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
168 $ info )
169 CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
170 infot = 10
171 CALL cgeev( 'N', 'V', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
172 $ info )
173 CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
174 infot = 12
175 CALL cgeev( 'V', 'V', 1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
176 $ info )
177 CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
178 nt = nt + 7
179*
180 ELSE IF( lsamen( 2, c2, 'ES' ) ) THEN
181*
182* Test CGEES
183*
184 srnamt = 'CGEES '
185 infot = 1
186 CALL cgees( 'X', 'N', cslect, 0, a, 1, sdim, x, vl, 1, w, 1,
187 $ rw, b, info )
188 CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
189 infot = 2
190 CALL cgees( 'N', 'X', cslect, 0, a, 1, sdim, x, vl, 1, w, 1,
191 $ rw, b, info )
192 CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
193 infot = 4
194 CALL cgees( 'n', 's', CSLECT, -1, A, 1, SDIM, X, VL, 1, W, 1,
195 $ RW, B, INFO )
196 CALL CHKXER( 'cgees ', INFOT, NOUT, LERR, OK )
197 INFOT = 6
198 CALL CGEES( 'n', 's', CSLECT, 2, A, 1, SDIM, X, VL, 1, W, 4,
199 $ RW, B, INFO )
200 CALL CHKXER( 'cgees ', INFOT, NOUT, LERR, OK )
201 INFOT = 10
202 CALL CGEES( 'v', 's', CSLECT, 2, A, 2, SDIM, X, VL, 1, W, 4,
203 $ RW, B, INFO )
204 CALL CHKXER( 'cgees ', INFOT, NOUT, LERR, OK )
205 INFOT = 12
206 CALL CGEES( 'n', 's', CSLECT, 1, A, 1, SDIM, X, VL, 1, W, 1,
207 $ RW, B, INFO )
208 CALL CHKXER( 'cgees ', INFOT, NOUT, LERR, OK )
209 NT = NT + 6
210*
211 ELSE IF( LSAMEN( 2, C2, 'vx' ) ) THEN
212*
213* Test CGEEVX
214*
215 SRNAMT = 'cgeevx'
216 INFOT = 1
217 CALL CGEEVX( '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( 'cgeevx', INFOT, NOUT, LERR, OK )
220 INFOT = 2
221 CALL CGEEVX( '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( 'cgeevx', INFOT, NOUT, LERR, OK )
224 INFOT = 3
225 CALL CGEEVX( '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( 'cgeevx', INFOT, NOUT, LERR, OK )
228 INFOT = 4
229 CALL CGEEVX( '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( 'cgeevx', INFOT, NOUT, LERR, OK )
232 INFOT = 5
233 CALL CGEEVX( '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( 'cgeevx', INFOT, NOUT, LERR, OK )
236 INFOT = 7
237 CALL CGEEVX( '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( 'cgeevx', INFOT, NOUT, LERR, OK )
240 INFOT = 10
241 CALL CGEEVX( '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( 'cgeevx', INFOT, NOUT, LERR, OK )
244 INFOT = 12
245 CALL CGEEVX( '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( 'cgeevx', INFOT, NOUT, LERR, OK )
248 INFOT = 20
249 CALL CGEEVX( '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( 'cgeevx', INFOT, NOUT, LERR, OK )
252 INFOT = 20
253 CALL CGEEVX( '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( 'cgeevx', INFOT, NOUT, LERR, OK )
256 NT = NT + 10
257*
258 ELSE IF( LSAMEN( 2, C2, 'sx' ) ) THEN
259*
260* Test CGEESX
261*
262 SRNAMT = 'cgeesx'
263 INFOT = 1
264 CALL CGEESX( 'x', 'n', CSLECT, 'n', 0, A, 1, SDIM, X, VL, 1,
265 $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
266 CALL CHKXER( 'cgeesx', INFOT, NOUT, LERR, OK )
267 INFOT = 2
268 CALL CGEESX( 'n', 'x', CSLECT, 'n', 0, A, 1, SDIM, X, VL, 1,
269 $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
270 CALL CHKXER( 'cgeesx', INFOT, NOUT, LERR, OK )
271 INFOT = 4
272 CALL CGEESX( 'n', 'n', CSLECT, 'x', 0, A, 1, SDIM, X, VL, 1,
273 $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
274 CALL CHKXER( 'cgeesx', INFOT, NOUT, LERR, OK )
275 INFOT = 5
276 CALL CGEESX( 'n', 'n', CSLECT, 'n', -1, A, 1, SDIM, X, VL, 1,
277 $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
278 CALL CHKXER( 'cgeesx', INFOT, NOUT, LERR, OK )
279 INFOT = 7
280 CALL CGEESX( 'n', 'n', CSLECT, 'n', 2, A, 1, SDIM, X, VL, 1,
281 $ R1( 1 ), R2( 1 ), W, 4, RW, B, INFO )
282 CALL CHKXER( 'cgeesx', INFOT, NOUT, LERR, OK )
283 INFOT = 11
284 CALL CGEESX( 'v', 'n', cslect, 'N', 2, a, 2, sdim, x, vl, 1,
285 $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
286 CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
287 infot = 15
288 CALL cgeesx( 'N', 'N', cslect, 'N', 1, a, 1, sdim, x, vl, 1,
289 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
290 CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
291 nt = nt + 7
292*
293 ELSE IF( lsamen( 2, c2, 'BD' ) ) THEN
294*
295* Test CGESVD
296*
297 srnamt = 'CGESVD'
298 infot = 1
299 CALL cgesvd( 'X', 'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
300 $ info )
301 CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
302 infot = 2
303 CALL cgesvd( 'N', 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
304 $ info )
305 CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
306 infot = 2
307 CALL cgesvd( 'O', 'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
308 $ info )
309 CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
310 infot = 3
311 CALL cgesvd( 'N', 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
312 $ info )
313 CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
314 infot = 4
315 CALL cgesvd( 'N', 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw,
316 $ info )
317 CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
318 infot = 6
319 CALL cgesvd( 'N', 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw,
320 $ info )
321 CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
322 infot = 9
323 CALL cgesvd( 'A', 'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw,
324 $ info )
325 CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
326 infot = 11
327 CALL cgesvd( 'N', 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw,
328 $ info )
329 CALL chkxer( 'CGESVD', 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 CGESDD
339*
340 srnamt = 'CGESDD'
341 infot = 1
342 CALL cgesdd( 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
343 $ info )
344 CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
345 infot = 2
346 CALL cgesdd( 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
347 $ info )
348 CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
349 infot = 3
350 CALL cgesdd( 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
351 $ info )
352 CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
353 infot = 5
354 CALL cgesdd( 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
355 $ info )
356 CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
357 infot = 8
358 CALL cgesdd( 'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw, iw,
359 $ info )
360 CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
361 infot = 10
362 CALL cgesdd( 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
363 $ info )
364 CALL chkxer( 'cgesdd', 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 CGEJSV
374*
375 SRNAMT = 'cgejsv'
376 INFOT = 1
377 CALL CGEJSV( '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( 'cgejsv', INFOT, NOUT, LERR, OK )
381 INFOT = 2
382 CALL CGEJSV( '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( 'cgejsv', INFOT, NOUT, LERR, OK )
386 INFOT = 3
387 CALL CGEJSV( '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( 'cgejsv', INFOT, NOUT, LERR, OK )
391 INFOT = 4
392 CALL CGEJSV( '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( 'cgejsv', INFOT, NOUT, LERR, OK )
396 INFOT = 5
397 CALL CGEJSV( '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( 'cgejsv', INFOT, NOUT, LERR, OK )
401 INFOT = 6
402 CALL CGEJSV( '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( 'cgejsv', INFOT, NOUT, LERR, OK )
406 INFOT = 7
407 CALL CGEJSV( '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( 'cgejsv', INFOT, NOUT, LERR, OK )
411 INFOT = 8
412 CALL CGEJSV( '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( 'cgejsv', INFOT, NOUT, LERR, OK )
416 INFOT = 10
417 CALL CGEJSV( '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( 'cgejsv', INFOT, NOUT, LERR, OK )
421 INFOT = 13
422 CALL CGEJSV( '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( 'cgejsv', INFOT, NOUT, LERR, OK )
426 INFOT = 15
427 CALL CGEJSV( '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( 'cgejsv', 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 CGESVDX
440*
441 SRNAMT = 'cgesvdx'
442 INFOT = 1
443 CALL CGESVDX( '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( 'cgesvdx', INFOT, NOUT, LERR, OK )
446 INFOT = 2
447 CALL CGESVDX( '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( 'cgesvdx', INFOT, NOUT, LERR, OK )
450 INFOT = 3
451 CALL CGESVDX( '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( 'cgesvdx', INFOT, NOUT, LERR, OK )
454 INFOT = 4
455 CALL CGESVDX( '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( 'cgesvdx', INFOT, NOUT, LERR, OK )
458 INFOT = 5
459 CALL CGESVDX( '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( 'cgesvdx', INFOT, NOUT, LERR, OK )
462 INFOT = 7
463 CALL CGESVDX( '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( 'cgesvdx', INFOT, NOUT, LERR, OK )
466 INFOT = 8
467 CALL CGESVDX( '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( 'cgesvdx', INFOT, NOUT, LERR, OK )
470 INFOT = 9
471 CALL CGESVDX( '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( 'cgesvdx', INFOT, NOUT, LERR, OK )
474 INFOT = 10
475 CALL CGESVDX( '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( 'cgesvdx', INFOT, NOUT, LERR, OK )
478 INFOT = 11
479 CALL CGESVDX( '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( 'cgesvdx', INFOT, NOUT, LERR, OK )
482 INFOT = 15
483 CALL CGESVDX( '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( 'cgesvdx', INFOT, NOUT, LERR, OK )
486 INFOT = 17
487 CALL CGESVDX( '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( 'cgesvdx', 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 CGESVDQ
499*
500 SRNAMT = 'cgesvdq'
501 INFOT = 1
502 CALL CGESVDQ( '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( 'cgesvdq', INFOT, NOUT, LERR, OK )
505 INFOT = 2
506 CALL CGESVDQ( '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( 'cgesvdq', INFOT, NOUT, LERR, OK )
509 INFOT = 3
510 CALL CGESVDQ( '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( 'cgesvdq', INFOT, NOUT, LERR, OK )
513 INFOT = 4
514 CALL CGESVDQ( '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( 'cgesvdq', INFOT, NOUT, LERR, OK )
517 INFOT = 5
518 CALL CGESVDQ( '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( 'cgesvdq', INFOT, NOUT, LERR, OK )
521 INFOT = 6
522 CALL CGESVDQ( '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( 'cgesvdq', INFOT, NOUT, LERR, OK )
525 INFOT = 7
526 CALL CGESVDQ( '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( 'cgesvdq', INFOT, NOUT, LERR, OK )
529 INFOT = 9
530 CALL CGESVDQ( '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( 'cgesvdq', infot, nout, lerr, ok )
533 infot = 12
534 CALL cgesvdq( '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( 'CGESVDQ', infot, nout, lerr, ok )
537 infot = 14
538 CALL cgesvdq( '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( 'CGESVDQ', infot, nout, lerr, ok )
541 infot = 17
542 CALL cgesvdq( '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( 'CGESVDQ', 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 CERRED
571*
572 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
lsamen
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
cgeev
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:180
cgees
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 m...
Definition cgees.f:197
cgeesx
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:239
cgeevx
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:288
cgesvdx
subroutine cgesvdx(jobu, jobvt, range, m, n, a, lda, vl, vu, il, iu, ns, s, u, ldu, vt, ldvt, work, lwork, rwork, iwork, info)
CGESVDX computes the singular value decomposition (SVD) for GE matrices
Definition cgesvdx.f:270
cgesvd
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
cgesdd
subroutine cgesdd(jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, rwork, iwork, info)
CGESDD
Definition cgesdd.f:227
cgejsv
subroutine cgejsv(joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, cwork, lwork, rwork, lrwork, iwork, info)
CGEJSV
Definition cgejsv.f:568
cgesvdq
subroutine cgesvdq(joba, jobp, jobr, jobu, jobv, m, n, a, lda, s, u, ldu, v, ldv, numrank, iwork, liwork, cwork, lcwork, rwork, lrwork, info)
CGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE...
Definition cgesvdq.f:413
cerred
subroutine cerred(path, nunit)
CERRED
Definition cerred.f:70