84 parameter( nmax = 4, lw = 5*nmax )
86 parameter( one = 1.0e0, zero = 0.0e0 )
90 INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
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 )
106 LOGICAL LSAMEN, CSLECT
107 EXTERNAL lsamen, cslect
114 REAL SELWI( 20 ), SELWR( 20 )
119 INTEGER INFOT, NOUT, SELDIM, SELOPT
122 COMMON / infoc / infot, nout, ok, lerr
123 COMMON / srnamc / srnamt
124 COMMON / sslct / selopt, seldim, selval, selwr, selwi
129 WRITE( nout, fmt = * )
145 IF( lsamen( 2, c2,
'EV' ) )
THEN
151 CALL cgeev(
'X',
'N', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
153 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
155 CALL cgeev(
'N',
'X', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
157 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
159 CALL cgeev(
'N',
'N', -1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
161 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
163 CALL cgeev(
'N',
'N', 2, a, 1, x, vl, 1, vr, 1, w, 4, rw,
165 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
167 CALL cgeev(
'V',
'N', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
169 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
171 CALL cgeev(
'N',
'V', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
173 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
175 CALL cgeev(
'V',
'V', 1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
177 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
180 ELSE IF( lsamen( 2, c2,
'ES' ) )
THEN
186 CALL cgees(
'X',
'N', cslect, 0, a, 1, sdim, x, vl, 1, w, 1,
188 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
190 CALL cgees(
'N',
'X', cslect, 0, a, 1, sdim, x, vl, 1, w, 1,
192 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
194 CALL cgees(
'N',
'S', cslect, -1, a, 1, sdim, x, vl, 1, w, 1,
196 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
198 CALL cgees(
'N',
'S', cslect, 2, a, 1, sdim, x, vl, 1, w, 4,
200 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
202 CALL cgees(
'V',
'S', cslect, 2, a, 2, sdim, x, vl, 1, w, 4,
204 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
206 CALL cgees(
'N',
'S', cslect, 1, a, 1, sdim, x, vl, 1, w, 1,
208 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
211 ELSE IF( lsamen( 2, c2,
'VX' ) )
THEN
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
258 ELSE IF( lsamen( 2, c2,
'SX' ) )
THEN
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 )
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 )
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 )
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 )
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 )
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 )
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 )
293 ELSE IF( lsamen( 2, c2,
'BD' ) )
THEN
299 CALL cgesvd(
'X',
'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
301 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
303 CALL cgesvd(
'N',
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
305 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
307 CALL cgesvd(
'O',
'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
309 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
311 CALL cgesvd(
'N',
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
313 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
315 CALL cgesvd(
'N',
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw,
317 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
319 CALL cgesvd(
'N',
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw,
321 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
323 CALL cgesvd(
'A',
'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw,
325 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
327 CALL cgesvd(
'N',
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw,
329 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
332 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
335 WRITE( nout, fmt = 9998 )
342 CALL cgesdd(
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
344 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
346 CALL cgesdd(
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
348 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
350 CALL cgesdd(
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
352 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
354 CALL cgesdd(
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
356 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
358 CALL cgesdd(
'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw, iw,
360 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
362 CALL cgesdd(
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
364 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
367 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
370 WRITE( nout, fmt = 9998 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
433 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
436 WRITE( nout, fmt = 9998 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
492 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
495 WRITE( nout, fmt = 9998 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
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 )
547 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
550 WRITE( nout, fmt = 9998 )
556 IF( .NOT.lsamen( 2, c2,
'BD' ) )
THEN
558 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
561 WRITE( nout, fmt = 9998 )
565 9999
FORMAT( 1x, a,
' passed the tests of the error exits (', i3,
567 9998
FORMAT(
' *** ', a,
' failed the tests of the error exits ***' )
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine cerred(path, nunit)
CERRED
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