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 ***' )