87 parameter( nmax = 4, lw = 5*nmax )
88 DOUBLE PRECISION ONE, ZERO
89 parameter( one = 1.0d0, zero = 0.0d0 )
93 INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
94 DOUBLE PRECISION ABNRM
99 DOUBLE PRECISION R1( NMAX ), R2( NMAX ), RW( LW ), S( NMAX )
100 COMPLEX*16 A( NMAX, NMAX ), U( NMAX, NMAX ),
101 $ VL( NMAX, NMAX ), VR( NMAX, NMAX ),
102 $ VT( NMAX, NMAX ), W( 10*NMAX ), X( NMAX )
109 LOGICAL LSAMEN, ZSLECT
117 DOUBLE PRECISION SELWI( 20 ), SELWR( 20 )
122 INTEGER INFOT, NOUT, SELDIM, SELOPT
125 COMMON / infoc / infot, nout, ok, lerr
126 COMMON / srnamc / srnamt
127 COMMON / sslct / selopt, seldim, selval, selwr, selwi
132 WRITE( nout, fmt = * )
148 IF(
lsamen( 2, c2,
'EV' ) )
THEN
154 CALL zgeev(
'X',
'N', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
156 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
158 CALL zgeev(
'N',
'X', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
160 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
162 CALL zgeev(
'N',
'N', -1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
164 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
166 CALL zgeev(
'N',
'N', 2, a, 1, x, vl, 1, vr, 1, w, 4, rw,
168 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
170 CALL zgeev(
'V',
'N', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
172 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
174 CALL zgeev(
'N',
'V', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
176 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
178 CALL zgeev(
'V',
'V', 1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
180 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
183 ELSE IF(
lsamen( 2, c2,
'ES' ) )
THEN
189 CALL zgees(
'X',
'N',
zslect, 0, a, 1, sdim, x, vl, 1, w, 1,
191 CALL chkxer(
'ZGEES ', infot, nout, lerr, ok )
193 CALL zgees(
'N',
'X',
zslect, 0, a, 1, sdim, x, vl, 1, w, 1,
195 CALL chkxer(
'ZGEES ', infot, nout, lerr, ok )
197 CALL zgees(
'N',
'S',
zslect, -1, a, 1, sdim, x, vl, 1, w, 1,
199 CALL chkxer(
'ZGEES ', infot, nout, lerr, ok )
201 CALL zgees(
'N',
'S',
zslect, 2, a, 1, sdim, x, vl, 1, w, 4,
203 CALL chkxer(
'ZGEES ', infot, nout, lerr, ok )
205 CALL zgees(
'V',
'S',
zslect, 2, a, 2, sdim, x, vl, 1, w, 4,
207 CALL chkxer(
'ZGEES ', infot, nout, lerr, ok )
209 CALL zgees(
'N',
'S',
zslect, 1, a, 1, sdim, x, vl, 1, w, 1,
211 CALL chkxer(
'ZGEES ', infot, nout, lerr, ok )
214 ELSE IF(
lsamen( 2, c2,
'VX' ) )
THEN
220 CALL zgeevx(
'X',
'N',
'N',
'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
221 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
222 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
224 CALL zgeevx(
'N',
'X',
'N',
'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
225 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
226 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
228 CALL zgeevx(
'N',
'N',
'X',
'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
229 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
230 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
232 CALL zgeevx(
'N',
'N',
'N',
'X', 0, a, 1, x, vl, 1, vr, 1, ilo,
233 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
234 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
236 CALL zgeevx(
'N',
'N',
'N',
'N', -1, a, 1, x, vl, 1, vr, 1,
237 $ ilo, ihi, s, abnrm, r1, r2, w, 1, rw, info )
238 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
240 CALL zgeevx(
'N',
'N',
'N',
'N', 2, a, 1, x, vl, 1, vr, 1, ilo,
241 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
242 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
244 CALL zgeevx(
'N',
'V',
'N',
'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
245 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
246 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
248 CALL zgeevx(
'N',
'N',
'V',
'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
249 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
250 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
252 CALL zgeevx(
'N',
'N',
'N',
'N', 1, a, 1, x, vl, 1, vr, 1, ilo,
253 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
254 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
256 CALL zgeevx(
'N',
'N',
'V',
'V', 1, a, 1, x, vl, 1, vr, 1, ilo,
257 $ ihi, s, abnrm, r1, r2, w, 2, rw, info )
258 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
261 ELSE IF(
lsamen( 2, c2,
'SX' ) )
THEN
267 CALL zgeesx(
'X',
'N',
zslect,
'N', 0, a, 1, sdim, x, vl, 1,
268 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
269 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
271 CALL zgeesx(
'N',
'X',
zslect,
'N', 0, a, 1, sdim, x, vl, 1,
272 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
273 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
275 CALL zgeesx(
'N',
'N',
zslect,
'X', 0, a, 1, sdim, x, vl, 1,
276 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
277 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
279 CALL zgeesx(
'N',
'N',
zslect,
'N', -1, a, 1, sdim, x, vl, 1,
280 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
281 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
283 CALL zgeesx(
'N',
'N',
zslect,
'N', 2, a, 1, sdim, x, vl, 1,
284 $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
285 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
287 CALL zgeesx(
'V',
'N',
zslect,
'N', 2, a, 2, sdim, x, vl, 1,
288 $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
289 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
291 CALL zgeesx(
'N',
'N',
zslect,
'N', 1, a, 1, sdim, x, vl, 1,
292 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
293 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
296 ELSE IF(
lsamen( 2, c2,
'BD' ) )
THEN
302 CALL zgesvd(
'X',
'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
304 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
306 CALL zgesvd(
'N',
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
308 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
310 CALL zgesvd(
'O',
'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
312 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
314 CALL zgesvd(
'N',
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
316 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
318 CALL zgesvd(
'N',
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw,
320 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
322 CALL zgesvd(
'N',
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw,
324 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
326 CALL zgesvd(
'A',
'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw,
328 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
330 CALL zgesvd(
'N',
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw,
332 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
335 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
338 WRITE( nout, fmt = 9998 )
345 CALL zgesdd(
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
347 CALL chkxer(
'ZGESDD', infot, nout, lerr, ok )
349 CALL zgesdd(
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
351 CALL chkxer(
'ZGESDD', infot, nout, lerr, ok )
353 CALL zgesdd(
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
355 CALL chkxer(
'ZGESDD', infot, nout, lerr, ok )
357 CALL zgesdd(
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
359 CALL chkxer(
'ZGESDD', infot, nout, lerr, ok )
361 CALL zgesdd(
'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw, iw,
363 CALL chkxer(
'ZGESDD', infot, nout, lerr, ok )
365 CALL zgesdd(
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
367 CALL chkxer(
'ZGESDD', infot, nout, lerr, ok )
370 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
373 WRITE( nout, fmt = 9998 )
380 CALL zgejsv(
'X',
'U',
'V',
'R',
'N',
'N',
381 $ 0, 0, a, 1, s, u, 1, vt, 1,
382 $ w, 1, rw, 1, iw, info)
383 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
385 CALL zgejsv(
'G',
'X',
'V',
'R',
'N',
'N',
386 $ 0, 0, a, 1, s, u, 1, vt, 1,
387 $ w, 1, rw, 1, iw, info)
388 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
390 CALL zgejsv(
'G',
'U',
'X',
'R',
'N',
'N',
391 $ 0, 0, a, 1, s, u, 1, vt, 1,
392 $ w, 1, rw, 1, iw, info)
393 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
395 CALL zgejsv(
'G',
'U',
'V',
'X',
'N',
'N',
396 $ 0, 0, a, 1, s, u, 1, vt, 1,
397 $ w, 1, rw, 1, iw, info)
398 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
400 CALL zgejsv(
'G',
'U',
'V',
'R',
'X',
'N',
401 $ 0, 0, a, 1, s, u, 1, vt, 1,
402 $ w, 1, rw, 1, iw, info)
403 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
405 CALL zgejsv(
'G',
'U',
'V',
'R',
'N',
'X',
406 $ 0, 0, a, 1, s, u, 1, vt, 1,
407 $ w, 1, rw, 1, iw, info)
408 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
410 CALL zgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
411 $ -1, 0, a, 1, s, u, 1, vt, 1,
412 $ w, 1, rw, 1, iw, info)
413 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
415 CALL zgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
416 $ 0, -1, a, 1, s, u, 1, vt, 1,
417 $ w, 1, rw, 1, iw, info)
418 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
420 CALL zgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
421 $ 2, 1, a, 1, s, u, 1, vt, 1,
422 $ w, 1, rw, 1, iw, info)
423 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
425 CALL zgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
426 $ 2, 2, a, 2, s, u, 1, vt, 2,
427 $ w, 1, rw, 1, iw, info)
428 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
430 CALL zgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
431 $ 2, 2, a, 2, s, u, 2, vt, 1,
432 $ w, 1, rw, 1, iw, info)
433 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
436 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
439 WRITE( nout, fmt = 9998 )
446 CALL zgesvdx(
'X',
'N',
'A', 0, 0, a, 1, zero, zero,
447 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
448 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
450 CALL zgesvdx(
'N',
'X',
'A', 0, 0, a, 1, zero, zero,
451 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
452 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
454 CALL zgesvdx(
'N',
'N',
'X', 0, 0, a, 1, zero, zero,
455 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
456 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
458 CALL zgesvdx(
'N',
'N',
'A', -1, 0, a, 1, zero, zero,
459 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
460 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
462 CALL zgesvdx(
'N',
'N',
'A', 0, -1, a, 1, zero, zero,
463 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
464 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
466 CALL zgesvdx(
'N',
'N',
'A', 2, 1, a, 1, zero, zero,
467 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
468 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
470 CALL zgesvdx(
'N',
'N',
'V', 2, 1, a, 2, -one, zero,
471 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
472 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
474 CALL zgesvdx(
'N',
'N',
'V', 2, 1, a, 2, one, zero,
475 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
476 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
478 CALL zgesvdx(
'N',
'N',
'I', 2, 2, a, 2, zero, zero,
479 $ 0, 1, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
480 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
482 CALL zgesvdx(
'V',
'N',
'I', 2, 2, a, 2, zero, zero,
483 $ 1, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
484 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
486 CALL zgesvdx(
'V',
'N',
'A', 2, 2, a, 2, zero, zero,
487 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
488 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
490 CALL zgesvdx(
'N',
'V',
'A', 2, 2, a, 2, zero, zero,
491 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
492 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
495 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
498 WRITE( nout, fmt = 9998 )
505 CALL zgesvdq(
'X',
'P',
'T',
'A',
'A', 0, 0, a, 1, s, u,
506 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
507 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
509 CALL zgesvdq(
'A',
'X',
'T',
'A',
'A', 0, 0, a, 1, s, u,
510 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
511 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
513 CALL zgesvdq(
'A',
'P',
'X',
'A',
'A', 0, 0, a, 1, s, u,
514 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
515 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
517 CALL zgesvdq(
'A',
'P',
'T',
'X',
'A', 0, 0, a, 1, s, u,
518 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
519 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
521 CALL zgesvdq(
'A',
'P',
'T',
'A',
'X', 0, 0, a, 1, s, u,
522 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
523 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
525 CALL zgesvdq(
'A',
'P',
'T',
'A',
'A', -1, 0, a, 1, s, u,
526 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
527 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
529 CALL zgesvdq(
'A',
'P',
'T',
'A',
'A', 0, 1, a, 1, s, u,
530 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
531 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
533 CALL zgesvdq(
'A',
'P',
'T',
'A',
'A', 1, 1, a, 0, s, u,
534 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
535 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
537 CALL zgesvdq(
'A',
'P',
'T',
'A',
'A', 1, 1, a, 1, s, u,
538 $ -1, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
539 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
541 CALL zgesvdq(
'A',
'P',
'T',
'A',
'A', 1, 1, a, 1, s, u,
542 $ 1, vt, -1, ns, iw, 1, w, 1, rw, 1, info )
543 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
545 CALL zgesvdq(
'A',
'P',
'T',
'A',
'A', 1, 1, a, 1, s, u,
546 $ 1, vt, 1, ns, iw, -5, w, 1, rw, 1, info )
547 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
550 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
553 WRITE( nout, fmt = 9998 )
559 IF( .NOT.
lsamen( 2, c2,
'BD' ) )
THEN
561 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
564 WRITE( nout, fmt = 9998 )
568 9999
FORMAT( 1x, a,
' passed the tests of the error exits (', i3,
570 9998
FORMAT(
' *** ', a,
' failed the tests of the error exits ***' )