85 parameter ( nmax = 4, lw = 5*nmax )
87 parameter ( one = 1.0e0, zero = 0.0e0 )
91 INTEGER i, ihi, ilo, info, j, ns, nt, sdim
97 REAL r1( nmax ), r2( nmax ), rw( lw ), s( nmax )
98 COMPLEX a( nmax, nmax ), u( nmax, nmax ),
99 $ vl( nmax, nmax ), vr( nmax, nmax ),
100 $ vt( nmax, nmax ), w( 10*nmax ), x( nmax )
115 REAL selwi( 20 ), selwr( 20 )
120 INTEGER infot, nout, seldim, selopt
123 COMMON / infoc / infot, nout, ok, lerr
124 COMMON / srnamc / srnamt
125 COMMON / sslct / selopt, seldim, selval, selwr, selwi
130 WRITE( nout, fmt = * )
146 IF(
lsamen( 2, c2,
'EV' ) )
THEN
152 CALL cgeev(
'X',
'N', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
154 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
156 CALL cgeev(
'N',
'X', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
158 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
160 CALL cgeev(
'N',
'N', -1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
162 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
164 CALL cgeev(
'N',
'N', 2, a, 1, x, vl, 1, vr, 1, w, 4, rw,
166 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
168 CALL cgeev(
'V',
'N', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
170 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
172 CALL cgeev(
'N',
'V', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
174 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
176 CALL cgeev(
'V',
'V', 1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
178 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
181 ELSE IF(
lsamen( 2, c2,
'ES' ) )
THEN
187 CALL cgees(
'X',
'N',
cslect, 0, a, 1, sdim, x, vl, 1, w, 1,
189 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
191 CALL cgees(
'N',
'X',
cslect, 0, a, 1, sdim, x, vl, 1, w, 1,
193 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
195 CALL cgees(
'N',
'S',
cslect, -1, a, 1, sdim, x, vl, 1, w, 1,
197 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
199 CALL cgees(
'N',
'S',
cslect, 2, a, 1, sdim, x, vl, 1, w, 4,
201 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
203 CALL cgees(
'V',
'S',
cslect, 2, a, 2, sdim, x, vl, 1, w, 4,
205 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
207 CALL cgees(
'N',
'S',
cslect, 1, a, 1, sdim, x, vl, 1, w, 1,
209 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
212 ELSE IF(
lsamen( 2, c2,
'VX' ) )
THEN
218 CALL cgeevx(
'X',
'N',
'N',
'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
219 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
220 CALL chkxer(
'CGEEVX', infot, nout, lerr, ok )
222 CALL cgeevx(
'N',
'X',
'N',
'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
223 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
224 CALL chkxer(
'CGEEVX', infot, nout, lerr, ok )
226 CALL cgeevx(
'N',
'N',
'X',
'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
227 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
228 CALL chkxer(
'CGEEVX', infot, nout, lerr, ok )
230 CALL cgeevx(
'N',
'N',
'N',
'X', 0, a, 1, x, vl, 1, vr, 1, ilo,
231 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
232 CALL chkxer(
'CGEEVX', infot, nout, lerr, ok )
234 CALL cgeevx(
'N',
'N',
'N',
'N', -1, a, 1, x, vl, 1, vr, 1,
235 $ ilo, ihi, s, abnrm, r1, r2, w, 1, rw, info )
236 CALL chkxer(
'CGEEVX', infot, nout, lerr, ok )
238 CALL cgeevx(
'N',
'N',
'N',
'N', 2, a, 1, x, vl, 1, vr, 1, ilo,
239 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
240 CALL chkxer(
'CGEEVX', infot, nout, lerr, ok )
242 CALL cgeevx(
'N',
'V',
'N',
'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
243 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
244 CALL chkxer(
'CGEEVX', infot, nout, lerr, ok )
246 CALL cgeevx(
'N',
'N',
'V',
'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
247 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
248 CALL chkxer(
'CGEEVX', infot, nout, lerr, ok )
250 CALL cgeevx(
'N',
'N',
'N',
'N', 1, a, 1, x, vl, 1, vr, 1, ilo,
251 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
252 CALL chkxer(
'CGEEVX', infot, nout, lerr, ok )
254 CALL cgeevx(
'N',
'N',
'V',
'V', 1, a, 1, x, vl, 1, vr, 1, ilo,
255 $ ihi, s, abnrm, r1, r2, w, 2, rw, info )
256 CALL chkxer(
'CGEEVX', infot, nout, lerr, ok )
259 ELSE IF(
lsamen( 2, c2,
'SX' ) )
THEN
265 CALL cgeesx(
'X',
'N',
cslect,
'N', 0, a, 1, sdim, x, vl, 1,
266 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
267 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
269 CALL cgeesx(
'N',
'X',
cslect,
'N', 0, a, 1, sdim, x, vl, 1,
270 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
271 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
273 CALL cgeesx(
'N',
'N',
cslect,
'X', 0, a, 1, sdim, x, vl, 1,
274 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
275 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
277 CALL cgeesx(
'N',
'N',
cslect,
'N', -1, a, 1, sdim, x, vl, 1,
278 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
279 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
281 CALL cgeesx(
'N',
'N',
cslect,
'N', 2, a, 1, sdim, x, vl, 1,
282 $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
283 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
285 CALL cgeesx(
'V',
'N',
cslect,
'N', 2, a, 2, sdim, x, vl, 1,
286 $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
287 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
289 CALL cgeesx(
'N',
'N',
cslect,
'N', 1, a, 1, sdim, x, vl, 1,
290 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
291 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
294 ELSE IF(
lsamen( 2, c2,
'BD' ) )
THEN
300 CALL cgesvd(
'X',
'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
302 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
304 CALL cgesvd(
'N',
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
306 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
308 CALL cgesvd(
'O',
'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
310 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
312 CALL cgesvd(
'N',
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
314 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
316 CALL cgesvd(
'N',
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw,
318 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
320 CALL cgesvd(
'N',
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw,
322 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
324 CALL cgesvd(
'A',
'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw,
326 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
328 CALL cgesvd(
'N',
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw,
330 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
333 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
336 WRITE( nout, fmt = 9998 )
343 CALL cgesdd(
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
345 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
347 CALL cgesdd(
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
349 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
351 CALL cgesdd(
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
353 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
355 CALL cgesdd(
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
357 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
359 CALL cgesdd(
'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw, iw,
361 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
363 CALL cgesdd(
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
365 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
368 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
371 WRITE( nout, fmt = 9998 )
378 CALL cgejsv(
'X',
'U',
'V',
'R',
'N',
'N',
379 $ 0, 0, a, 1, s, u, 1, vt, 1,
380 $ w, 1, rw, 1, iw, info)
381 CALL chkxer(
'CGEJSV', infot, nout, lerr, ok )
383 CALL cgejsv(
'G',
'X',
'V',
'R',
'N',
'N',
384 $ 0, 0, a, 1, s, u, 1, vt, 1,
385 $ w, 1, rw, 1, iw, info)
386 CALL chkxer(
'CGEJSV', infot, nout, lerr, ok )
388 CALL cgejsv(
'G',
'U',
'X',
'R',
'N',
'N',
389 $ 0, 0, a, 1, s, u, 1, vt, 1,
390 $ w, 1, rw, 1, iw, info)
391 CALL chkxer(
'CGEJSV', infot, nout, lerr, ok )
393 CALL cgejsv(
'G',
'U',
'V',
'X',
'N',
'N',
394 $ 0, 0, a, 1, s, u, 1, vt, 1,
395 $ w, 1, rw, 1, iw, info)
396 CALL chkxer(
'CGEJSV', infot, nout, lerr, ok )
398 CALL cgejsv(
'G',
'U',
'V',
'R',
'X',
'N',
399 $ 0, 0, a, 1, s, u, 1, vt, 1,
400 $ w, 1, rw, 1, iw, info)
401 CALL chkxer(
'CGEJSV', infot, nout, lerr, ok )
403 CALL cgejsv(
'G',
'U',
'V',
'R',
'N',
'X',
404 $ 0, 0, a, 1, s, u, 1, vt, 1,
405 $ w, 1, rw, 1, iw, info)
406 CALL chkxer(
'CGEJSV', infot, nout, lerr, ok )
408 CALL cgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
409 $ -1, 0, a, 1, s, u, 1, vt, 1,
410 $ w, 1, rw, 1, iw, info)
411 CALL chkxer(
'CGEJSV', infot, nout, lerr, ok )
413 CALL cgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
414 $ 0, -1, a, 1, s, u, 1, vt, 1,
415 $ w, 1, rw, 1, iw, info)
416 CALL chkxer(
'CGEJSV', infot, nout, lerr, ok )
418 CALL cgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
419 $ 2, 1, a, 1, s, u, 1, vt, 1,
420 $ w, 1, rw, 1, iw, info)
421 CALL chkxer(
'CGEJSV', infot, nout, lerr, ok )
423 CALL cgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
424 $ 2, 2, a, 2, s, u, 1, vt, 2,
425 $ w, 1, rw, 1, iw, info)
426 CALL chkxer(
'CGEJSV', infot, nout, lerr, ok )
428 CALL cgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
429 $ 2, 2, a, 2, s, u, 2, vt, 1,
430 $ w, 1, rw, 1, iw, info)
431 CALL chkxer(
'CGEJSV', infot, nout, lerr, ok )
434 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
437 WRITE( nout, fmt = 9998 )
444 CALL cgesvdx(
'X',
'N',
'A', 0, 0, a, 1, zero, zero,
445 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
446 CALL chkxer(
'CGESVDX', infot, nout, lerr, ok )
448 CALL cgesvdx(
'N',
'X',
'A', 0, 0, a, 1, zero, zero,
449 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
450 CALL chkxer(
'CGESVDX', infot, nout, lerr, ok )
452 CALL cgesvdx(
'N',
'N',
'X', 0, 0, a, 1, zero, zero,
453 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
454 CALL chkxer(
'CGESVDX', infot, nout, lerr, ok )
456 CALL cgesvdx(
'N',
'N',
'A', -1, 0, a, 1, zero, zero,
457 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
458 CALL chkxer(
'CGESVDX', infot, nout, lerr, ok )
460 CALL cgesvdx(
'N',
'N',
'A', 0, -1, a, 1, zero, zero,
461 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
462 CALL chkxer(
'CGESVDX', infot, nout, lerr, ok )
464 CALL cgesvdx(
'N',
'N',
'A', 2, 1, a, 1, zero, zero,
465 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
466 CALL chkxer(
'CGESVDX', infot, nout, lerr, ok )
468 CALL cgesvdx(
'N',
'N',
'V', 2, 1, a, 2, -one, zero,
469 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
470 CALL chkxer(
'CGESVDX', infot, nout, lerr, ok )
472 CALL cgesvdx(
'N',
'N',
'V', 2, 1, a, 2, one, zero,
473 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
474 CALL chkxer(
'CGESVDX', infot, nout, lerr, ok )
476 CALL cgesvdx(
'N',
'N',
'I', 2, 2, a, 2, zero, zero,
477 $ 0, 1, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
478 CALL chkxer(
'CGESVDX', infot, nout, lerr, ok )
480 CALL cgesvdx(
'V',
'N',
'I', 2, 2, a, 2, zero, zero,
481 $ 1, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
482 CALL chkxer(
'CGESVDX', infot, nout, lerr, ok )
484 CALL cgesvdx(
'V',
'N',
'A', 2, 2, a, 2, zero, zero,
485 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
486 CALL chkxer(
'CGESVDX', infot, nout, lerr, ok )
488 CALL cgesvdx(
'N',
'V',
'A', 2, 2, a, 2, zero, zero,
489 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
490 CALL chkxer(
'CGESVDX', infot, nout, lerr, ok )
493 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
496 WRITE( nout, fmt = 9998 )
502 IF( .NOT.
lsamen( 2, c2,
'BD' ) )
THEN
504 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
507 WRITE( nout, fmt = 9998 )
511 9999
FORMAT( 1x, a,
' passed the tests of the error exits (', i3,
513 9998
FORMAT(
' *** ', a,
' failed the tests of the error exits ***' )
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 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
logical function cslect(Z)
CSLECT
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
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 ...
logical function lsamen(N, CA, CB)
LSAMEN
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 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 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 cgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, IWORK, INFO)
CGESDD
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