66 SUBROUTINE zerred( PATH, NUNIT )
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...