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 )
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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
logical function lsamen(N, CA, CB)
LSAMEN
logical function cslect(Z)
CSLECT
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 ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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 ...