82 parameter( nmax = 4, lw = 5*nmax )
83 DOUBLE PRECISION ONE, ZERO
84 parameter( one = 1.0d0, zero = 0.0d0 )
88 INTEGER I, IHI, ILO, INFO, J, NT, SDIM
89 DOUBLE PRECISION ABNRM
94 DOUBLE PRECISION R1( nmax ), R2( nmax ), RW( lw ), S( nmax )
95 COMPLEX*16 A( nmax, nmax ), U( nmax, nmax ),
96 $ vl( nmax, nmax ), vr( nmax, nmax ),
97 $ vt( nmax, nmax ), w( 4*nmax ), x( nmax )
104 LOGICAL LSAMEN, ZSLECT
105 EXTERNAL lsamen, zslect
112 DOUBLE PRECISION SELWI( 20 ), SELWR( 20 )
117 INTEGER INFOT, NOUT, SELDIM, SELOPT
120 COMMON / infoc / infot, nout, ok, lerr
121 COMMON / srnamc / srnamt
122 COMMON / sslct / selopt, seldim, selval, selwr, selwi
127 WRITE( nout, fmt = * )
143 IF( lsamen( 2, c2,
'EV' ) )
THEN
149 CALL
zgeev(
'X',
'N', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
151 CALL
chkxer(
'ZGEEV ', infot, nout, lerr, ok )
153 CALL
zgeev(
'N',
'X', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
155 CALL
chkxer(
'ZGEEV ', infot, nout, lerr, ok )
157 CALL
zgeev(
'N',
'N', -1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
159 CALL
chkxer(
'ZGEEV ', infot, nout, lerr, ok )
161 CALL
zgeev(
'N',
'N', 2, a, 1, x, vl, 1, vr, 1, w, 4, rw,
163 CALL
chkxer(
'ZGEEV ', infot, nout, lerr, ok )
165 CALL
zgeev(
'V',
'N', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
167 CALL
chkxer(
'ZGEEV ', infot, nout, lerr, ok )
169 CALL
zgeev(
'N',
'V', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
171 CALL
chkxer(
'ZGEEV ', infot, nout, lerr, ok )
173 CALL
zgeev(
'V',
'V', 1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
175 CALL
chkxer(
'ZGEEV ', infot, nout, lerr, ok )
178 ELSE IF( lsamen( 2, c2,
'ES' ) )
THEN
184 CALL
zgees(
'X',
'N', zslect, 0, a, 1, sdim, x, vl, 1, w, 1,
186 CALL
chkxer(
'ZGEES ', infot, nout, lerr, ok )
188 CALL
zgees(
'N',
'X', zslect, 0, a, 1, sdim, x, vl, 1, w, 1,
190 CALL
chkxer(
'ZGEES ', infot, nout, lerr, ok )
192 CALL
zgees(
'N',
'S', zslect, -1, a, 1, sdim, x, vl, 1, w, 1,
194 CALL
chkxer(
'ZGEES ', infot, nout, lerr, ok )
196 CALL
zgees(
'N',
'S', zslect, 2, a, 1, sdim, x, vl, 1, w, 4,
198 CALL
chkxer(
'ZGEES ', infot, nout, lerr, ok )
200 CALL
zgees(
'V',
'S', zslect, 2, a, 2, sdim, x, vl, 1, w, 4,
202 CALL
chkxer(
'ZGEES ', infot, nout, lerr, ok )
204 CALL
zgees(
'N',
'S', zslect, 1, a, 1, sdim, x, vl, 1, w, 1,
206 CALL
chkxer(
'ZGEES ', infot, nout, lerr, ok )
209 ELSE IF( lsamen( 2, c2,
'VX' ) )
THEN
215 CALL
zgeevx(
'X',
'N',
'N',
'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
216 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
217 CALL
chkxer(
'ZGEEVX', infot, nout, lerr, ok )
219 CALL
zgeevx(
'N',
'X',
'N',
'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
220 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
221 CALL
chkxer(
'ZGEEVX', infot, nout, lerr, ok )
223 CALL
zgeevx(
'N',
'N',
'X',
'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
224 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
225 CALL
chkxer(
'ZGEEVX', infot, nout, lerr, ok )
227 CALL
zgeevx(
'N',
'N',
'N',
'X', 0, a, 1, x, vl, 1, vr, 1, ilo,
228 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
229 CALL
chkxer(
'ZGEEVX', infot, nout, lerr, ok )
231 CALL
zgeevx(
'N',
'N',
'N',
'N', -1, a, 1, x, vl, 1, vr, 1,
232 $ ilo, ihi, s, abnrm, r1, r2, w, 1, rw, info )
233 CALL
chkxer(
'ZGEEVX', infot, nout, lerr, ok )
235 CALL
zgeevx(
'N',
'N',
'N',
'N', 2, a, 1, x, vl, 1, vr, 1, ilo,
236 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
237 CALL
chkxer(
'ZGEEVX', infot, nout, lerr, ok )
239 CALL
zgeevx(
'N',
'V',
'N',
'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
240 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
241 CALL
chkxer(
'ZGEEVX', infot, nout, lerr, ok )
243 CALL
zgeevx(
'N',
'N',
'V',
'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
244 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
245 CALL
chkxer(
'ZGEEVX', infot, nout, lerr, ok )
247 CALL
zgeevx(
'N',
'N',
'N',
'N', 1, a, 1, x, vl, 1, vr, 1, ilo,
248 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
249 CALL
chkxer(
'ZGEEVX', infot, nout, lerr, ok )
251 CALL
zgeevx(
'N',
'N',
'V',
'V', 1, a, 1, x, vl, 1, vr, 1, ilo,
252 $ ihi, s, abnrm, r1, r2, w, 2, rw, info )
253 CALL
chkxer(
'ZGEEVX', infot, nout, lerr, ok )
256 ELSE IF( lsamen( 2, c2,
'SX' ) )
THEN
262 CALL
zgeesx(
'X',
'N', zslect,
'N', 0, a, 1, sdim, x, vl, 1,
263 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
264 CALL
chkxer(
'ZGEESX', infot, nout, lerr, ok )
266 CALL
zgeesx(
'N',
'X', zslect,
'N', 0, a, 1, sdim, x, vl, 1,
267 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
268 CALL
chkxer(
'ZGEESX', infot, nout, lerr, ok )
270 CALL
zgeesx(
'N',
'N', zslect,
'X', 0, a, 1, sdim, x, vl, 1,
271 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
272 CALL
chkxer(
'ZGEESX', infot, nout, lerr, ok )
274 CALL
zgeesx(
'N',
'N', zslect,
'N', -1, a, 1, sdim, x, vl, 1,
275 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
276 CALL
chkxer(
'ZGEESX', infot, nout, lerr, ok )
278 CALL
zgeesx(
'N',
'N', zslect,
'N', 2, a, 1, sdim, x, vl, 1,
279 $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
280 CALL
chkxer(
'ZGEESX', infot, nout, lerr, ok )
282 CALL
zgeesx(
'V',
'N', zslect,
'N', 2, a, 2, sdim, x, vl, 1,
283 $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
284 CALL
chkxer(
'ZGEESX', infot, nout, lerr, ok )
286 CALL
zgeesx(
'N',
'N', zslect,
'N', 1, a, 1, sdim, x, vl, 1,
287 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
288 CALL
chkxer(
'ZGEESX', infot, nout, lerr, ok )
291 ELSE IF( lsamen( 2, c2,
'BD' ) )
THEN
297 CALL
zgesvd(
'X',
'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
299 CALL
chkxer(
'ZGESVD', infot, nout, lerr, ok )
301 CALL
zgesvd(
'N',
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
303 CALL
chkxer(
'ZGESVD', infot, nout, lerr, ok )
305 CALL
zgesvd(
'O',
'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
307 CALL
chkxer(
'ZGESVD', infot, nout, lerr, ok )
309 CALL
zgesvd(
'N',
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
311 CALL
chkxer(
'ZGESVD', infot, nout, lerr, ok )
313 CALL
zgesvd(
'N',
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw,
315 CALL
chkxer(
'ZGESVD', infot, nout, lerr, ok )
317 CALL
zgesvd(
'N',
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw,
319 CALL
chkxer(
'ZGESVD', infot, nout, lerr, ok )
321 CALL
zgesvd(
'A',
'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw,
323 CALL
chkxer(
'ZGESVD', infot, nout, lerr, ok )
325 CALL
zgesvd(
'N',
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw,
327 CALL
chkxer(
'ZGESVD', infot, nout, lerr, ok )
330 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
333 WRITE( nout, fmt = 9998 )
340 CALL
zgesdd(
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
342 CALL
chkxer(
'ZGESDD', infot, nout, lerr, ok )
344 CALL
zgesdd(
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
346 CALL
chkxer(
'ZGESDD', infot, nout, lerr, ok )
348 CALL
zgesdd(
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
350 CALL
chkxer(
'ZGESDD', infot, nout, lerr, ok )
352 CALL
zgesdd(
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
354 CALL
chkxer(
'ZGESDD', infot, nout, lerr, ok )
356 CALL
zgesdd(
'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw, iw,
358 CALL
chkxer(
'ZGESDD', infot, nout, lerr, ok )
360 CALL
zgesdd(
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
362 CALL
chkxer(
'ZGESDD', infot, nout, lerr, ok )
365 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
368 WRITE( nout, fmt = 9998 )
374 IF( .NOT.lsamen( 2, c2,
'BD' ) )
THEN
376 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
379 WRITE( nout, fmt = 9998 )
383 9999
FORMAT( 1x, a,
' passed the tests of the error exits (', i3,
385 9998
FORMAT(
' *** ', a,
' failed the tests of the error exits ***' )
subroutine zgees(JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, LDVS, WORK, LWORK, RWORK, BWORK, INFO)
ZGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
subroutine zgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, IWORK, INFO)
ZGESDD
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine zgeev(JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
ZGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
subroutine zgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, INFO)
ZGESVD computes the singular value decomposition (SVD) for GE matrices
subroutine zgeevx(BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, RWORK, INFO)
ZGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
subroutine zerred(PATH, NUNIT)
ZERRED
subroutine zgeesx(JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK, BWORK, INFO)
ZGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE...