66 SUBROUTINE cerred( PATH, NUNIT )
82 parameter( nmax = 4, lw = 5*nmax )
84 parameter( one = 1.0e0, zero = 0.0e0 )
88 INTEGER I, IHI, ILO, INFO, J, NT, SDIM
94 REAL R1( nmax ), R2( nmax ), RW( lw ), S( nmax )
95 COMPLEX A( nmax, nmax ), U( nmax, nmax ),
96 $ vl( nmax, nmax ), vr( nmax, nmax ),
97 $ vt( nmax, nmax ), w( 4*nmax ), x( nmax )
104 LOGICAL CSLECT, LSAMEN
105 EXTERNAL cslect, lsamen
112 REAL 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 cgeev(
'X',
'N', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
151 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
153 CALL cgeev(
'N',
'X', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
155 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
157 CALL cgeev(
'N',
'N', -1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
159 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
161 CALL cgeev(
'N',
'N', 2, a, 1, x, vl, 1, vr, 1, w, 4, rw,
163 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
165 CALL cgeev(
'V',
'N', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
167 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
169 CALL cgeev(
'N',
'V', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
171 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
173 CALL cgeev(
'V',
'V', 1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
175 CALL chkxer(
'CGEEV ', infot, nout, lerr, ok )
178 ELSE IF( lsamen( 2, c2,
'ES' ) )
THEN
184 CALL cgees(
'X',
'N', cslect, 0, a, 1, sdim, x, vl, 1, w, 1,
186 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
188 CALL cgees(
'N',
'X', cslect, 0, a, 1, sdim, x, vl, 1, w, 1,
190 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
192 CALL cgees(
'N',
'S', cslect, -1, a, 1, sdim, x, vl, 1, w, 1,
194 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
196 CALL cgees(
'N',
'S', cslect, 2, a, 1, sdim, x, vl, 1, w, 4,
198 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
200 CALL cgees(
'V',
'S', cslect, 2, a, 2, sdim, x, vl, 1, w, 4,
202 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
204 CALL cgees(
'N',
'S', cslect, 1, a, 1, sdim, x, vl, 1, w, 1,
206 CALL chkxer(
'CGEES ', infot, nout, lerr, ok )
209 ELSE IF( lsamen( 2, c2,
'VX' ) )
THEN
215 CALL cgeevx(
'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(
'CGEEVX', infot, nout, lerr, ok )
219 CALL cgeevx(
'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(
'CGEEVX', infot, nout, lerr, ok )
223 CALL cgeevx(
'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(
'CGEEVX', infot, nout, lerr, ok )
227 CALL cgeevx(
'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(
'CGEEVX', infot, nout, lerr, ok )
231 CALL cgeevx(
'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(
'CGEEVX', infot, nout, lerr, ok )
235 CALL cgeevx(
'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(
'CGEEVX', infot, nout, lerr, ok )
239 CALL cgeevx(
'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(
'CGEEVX', infot, nout, lerr, ok )
243 CALL cgeevx(
'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(
'CGEEVX', infot, nout, lerr, ok )
247 CALL cgeevx(
'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(
'CGEEVX', infot, nout, lerr, ok )
251 CALL cgeevx(
'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(
'CGEEVX', infot, nout, lerr, ok )
256 ELSE IF( lsamen( 2, c2,
'SX' ) )
THEN
262 CALL cgeesx(
'X',
'N', cslect,
'N', 0, a, 1, sdim, x, vl, 1,
263 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
264 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
266 CALL cgeesx(
'N',
'X', cslect,
'N', 0, a, 1, sdim, x, vl, 1,
267 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
268 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
270 CALL cgeesx(
'N',
'N', cslect,
'X', 0, a, 1, sdim, x, vl, 1,
271 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
272 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
274 CALL cgeesx(
'N',
'N', cslect,
'N', -1, a, 1, sdim, x, vl, 1,
275 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
276 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
278 CALL cgeesx(
'N',
'N', cslect,
'N', 2, a, 1, sdim, x, vl, 1,
279 $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
280 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
282 CALL cgeesx(
'V',
'N', cslect,
'N', 2, a, 2, sdim, x, vl, 1,
283 $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
284 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
286 CALL cgeesx(
'N',
'N', cslect,
'N', 1, a, 1, sdim, x, vl, 1,
287 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
288 CALL chkxer(
'CGEESX', infot, nout, lerr, ok )
291 ELSE IF( lsamen( 2, c2,
'BD' ) )
THEN
297 CALL cgesvd(
'X',
'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
299 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
301 CALL cgesvd(
'N',
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
303 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
305 CALL cgesvd(
'O',
'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
307 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
309 CALL cgesvd(
'N',
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
311 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
313 CALL cgesvd(
'N',
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw,
315 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
317 CALL cgesvd(
'N',
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw,
319 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
321 CALL cgesvd(
'A',
'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw,
323 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
325 CALL cgesvd(
'N',
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw,
327 CALL chkxer(
'CGESVD', infot, nout, lerr, ok )
330 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
333 WRITE( nout, fmt = 9998 )
340 CALL cgesdd(
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
342 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
344 CALL cgesdd(
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
346 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
348 CALL cgesdd(
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
350 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
352 CALL cgesdd(
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
354 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
356 CALL cgesdd(
'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw, iw,
358 CALL chkxer(
'CGESDD', infot, nout, lerr, ok )
360 CALL cgesdd(
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
362 CALL chkxer(
'CGESDD', 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 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 ...
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
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
subroutine cerred(PATH, NUNIT)
CERRED
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 cgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, IWORK, INFO)
CGESDD
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 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 ...