70
71
72
73
74
75
76 CHARACTER*3 PATH
77 INTEGER NUNIT
78
79
80
81
82
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
89 CHARACTER*2 C2
90 INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
91 REAL ABNRM
92
93
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
104
105
106 LOGICAL LSAMEN, CSLECT
108
109
110 INTRINSIC len_trim
111
112
113 LOGICAL SELVAL( 20 )
114 REAL SELWI( 20 ), SELWR( 20 )
115
116
117 LOGICAL LERR, OK
118 CHARACTER*32 SRNAMT
119 INTEGER INFOT, NOUT, SELDIM, SELOPT
120
121
122 COMMON / infoc / infot, nout, ok, lerr
123 COMMON / srnamc / srnamt
124 COMMON / sslct / selopt, seldim, selval, selwr, selwi
125
126
127
128 nout = nunit
129 WRITE( nout, fmt = * )
130 c2 = path( 2: 3 )
131
132
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
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
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
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
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
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
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
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
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
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
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
571
subroutine chkxer(srnamt, infot, nout, lerr, ok)
logical function cslect(z)
CSLECT
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...
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 ...
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
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
subroutine cgejsv(joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, cwork, lwork, rwork, lrwork, iwork, info)
CGEJSV
subroutine cgesdd(jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, rwork, iwork, info)
CGESDD
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
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...
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
logical function lsamen(n, ca, cb)
LSAMEN