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 ***' )