83 DOUBLE PRECISION one, zero
84 parameter( nmax = 4, one = 1.0d0, zero = 0.0d0 )
88 INTEGER i, ihi, ilo, info, j, nt, sdim
89 DOUBLE PRECISION abnrm
94 DOUBLE PRECISION a( nmax, nmax ), r1( nmax ), r2( nmax ),
95 $ s( nmax ), u( nmax, nmax ), vl( nmax, nmax ),
96 $ vr( nmax, nmax ), vt( nmax, nmax ),
97 $ w( 4*nmax ), wi( nmax ), wr( nmax )
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
dgeev(
'X',
'N', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
151 CALL
chkxer(
'DGEEV ', infot, nout, lerr, ok )
153 CALL
dgeev(
'N',
'X', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
155 CALL
chkxer(
'DGEEV ', infot, nout, lerr, ok )
157 CALL
dgeev(
'N',
'N', -1, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
159 CALL
chkxer(
'DGEEV ', infot, nout, lerr, ok )
161 CALL
dgeev(
'N',
'N', 2, a, 1, wr, wi, vl, 1, vr, 1, w, 6,
163 CALL
chkxer(
'DGEEV ', infot, nout, lerr, ok )
165 CALL
dgeev(
'V',
'N', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
167 CALL
chkxer(
'DGEEV ', infot, nout, lerr, ok )
169 CALL
dgeev(
'N',
'V', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
171 CALL
chkxer(
'DGEEV ', infot, nout, lerr, ok )
173 CALL
dgeev(
'V',
'V', 1, a, 1, wr, wi, vl, 1, vr, 1, w, 3,
175 CALL
chkxer(
'DGEEV ', infot, nout, lerr, ok )
178 ELSE IF(
lsamen( 2, c2,
'ES' ) )
THEN
184 CALL
dgees(
'X',
'N',
dslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
186 CALL
chkxer(
'DGEES ', infot, nout, lerr, ok )
188 CALL
dgees(
'N',
'X',
dslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
190 CALL
chkxer(
'DGEES ', infot, nout, lerr, ok )
192 CALL
dgees(
'N',
'S',
dslect, -1, a, 1, sdim, wr, wi, vl, 1, w,
194 CALL
chkxer(
'DGEES ', infot, nout, lerr, ok )
196 CALL
dgees(
'N',
'S',
dslect, 2, a, 1, sdim, wr, wi, vl, 1, w,
198 CALL
chkxer(
'DGEES ', infot, nout, lerr, ok )
200 CALL
dgees(
'V',
'S',
dslect, 2, a, 2, sdim, wr, wi, vl, 1, w,
202 CALL
chkxer(
'DGEES ', infot, nout, lerr, ok )
204 CALL
dgees(
'N',
'S',
dslect, 1, a, 1, sdim, wr, wi, vl, 1, w,
206 CALL
chkxer(
'DGEES ', infot, nout, lerr, ok )
209 ELSE IF(
lsamen( 2, c2,
'VX' ) )
THEN
215 CALL
dgeevx(
'X',
'N',
'N',
'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
216 $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
217 CALL
chkxer(
'DGEEVX', infot, nout, lerr, ok )
219 CALL
dgeevx(
'N',
'X',
'N',
'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
220 $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
221 CALL
chkxer(
'DGEEVX', infot, nout, lerr, ok )
223 CALL
dgeevx(
'N',
'N',
'X',
'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
224 $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
225 CALL
chkxer(
'DGEEVX', infot, nout, lerr, ok )
227 CALL
dgeevx(
'N',
'N',
'N',
'X', 0, a, 1, wr, wi, vl, 1, vr, 1,
228 $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
229 CALL
chkxer(
'DGEEVX', infot, nout, lerr, ok )
231 CALL
dgeevx(
'N',
'N',
'N',
'N', -1, a, 1, wr, wi, vl, 1, vr,
232 $ 1, ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
233 CALL
chkxer(
'DGEEVX', infot, nout, lerr, ok )
235 CALL
dgeevx(
'N',
'N',
'N',
'N', 2, a, 1, wr, wi, vl, 1, vr, 1,
236 $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
237 CALL
chkxer(
'DGEEVX', infot, nout, lerr, ok )
239 CALL
dgeevx(
'N',
'V',
'N',
'N', 2, a, 2, wr, wi, vl, 1, vr, 1,
240 $ ilo, ihi, s, abnrm, r1, r2, w, 6, iw, info )
241 CALL
chkxer(
'DGEEVX', infot, nout, lerr, ok )
243 CALL
dgeevx(
'N',
'N',
'V',
'N', 2, a, 2, wr, wi, vl, 1, vr, 1,
244 $ ilo, ihi, s, abnrm, r1, r2, w, 6, iw, info )
245 CALL
chkxer(
'DGEEVX', infot, nout, lerr, ok )
247 CALL
dgeevx(
'N',
'N',
'N',
'N', 1, a, 1, wr, wi, vl, 1, vr, 1,
248 $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
249 CALL
chkxer(
'DGEEVX', infot, nout, lerr, ok )
251 CALL
dgeevx(
'N',
'V',
'N',
'N', 1, a, 1, wr, wi, vl, 1, vr, 1,
252 $ ilo, ihi, s, abnrm, r1, r2, w, 2, iw, info )
253 CALL
chkxer(
'DGEEVX', infot, nout, lerr, ok )
255 CALL
dgeevx(
'N',
'N',
'V',
'V', 1, a, 1, wr, wi, vl, 1, vr, 1,
256 $ ilo, ihi, s, abnrm, r1, r2, w, 3, iw, info )
257 CALL
chkxer(
'DGEEVX', infot, nout, lerr, ok )
260 ELSE IF(
lsamen( 2, c2,
'SX' ) )
THEN
266 CALL
dgeesx(
'X',
'N',
dslect,
'N', 0, a, 1, sdim, wr, wi, vl,
267 $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
268 CALL
chkxer(
'DGEESX', infot, nout, lerr, ok )
270 CALL
dgeesx(
'N',
'X',
dslect,
'N', 0, a, 1, sdim, wr, wi, vl,
271 $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
272 CALL
chkxer(
'DGEESX', infot, nout, lerr, ok )
274 CALL
dgeesx(
'N',
'N',
dslect,
'X', 0, a, 1, sdim, wr, wi, vl,
275 $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
276 CALL
chkxer(
'DGEESX', infot, nout, lerr, ok )
278 CALL
dgeesx(
'N',
'N',
dslect,
'N', -1, a, 1, sdim, wr, wi, vl,
279 $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
280 CALL
chkxer(
'DGEESX', infot, nout, lerr, ok )
282 CALL
dgeesx(
'N',
'N',
dslect,
'N', 2, a, 1, sdim, wr, wi, vl,
283 $ 1, r1( 1 ), r2( 1 ), w, 6, iw, 1, b, info )
284 CALL
chkxer(
'DGEESX', infot, nout, lerr, ok )
286 CALL
dgeesx(
'V',
'N',
dslect,
'N', 2, a, 2, sdim, wr, wi, vl,
287 $ 1, r1( 1 ), r2( 1 ), w, 6, iw, 1, b, info )
288 CALL
chkxer(
'DGEESX', infot, nout, lerr, ok )
290 CALL
dgeesx(
'N',
'N',
dslect,
'N', 1, a, 1, sdim, wr, wi, vl,
291 $ 1, r1( 1 ), r2( 1 ), w, 2, iw, 1, b, info )
292 CALL
chkxer(
'DGEESX', infot, nout, lerr, ok )
295 ELSE IF(
lsamen( 2, c2,
'BD' ) )
THEN
301 CALL
dgesvd(
'X',
'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
302 CALL
chkxer(
'DGESVD', infot, nout, lerr, ok )
304 CALL
dgesvd(
'N',
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
305 CALL
chkxer(
'DGESVD', infot, nout, lerr, ok )
307 CALL
dgesvd(
'O',
'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
308 CALL
chkxer(
'DGESVD', infot, nout, lerr, ok )
310 CALL
dgesvd(
'N',
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1,
312 CALL
chkxer(
'DGESVD', infot, nout, lerr, ok )
314 CALL
dgesvd(
'N',
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1,
316 CALL
chkxer(
'DGESVD', infot, nout, lerr, ok )
318 CALL
dgesvd(
'N',
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, info )
319 CALL
chkxer(
'DGESVD', infot, nout, lerr, ok )
321 CALL
dgesvd(
'A',
'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, info )
322 CALL
chkxer(
'DGESVD', infot, nout, lerr, ok )
324 CALL
dgesvd(
'N',
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, info )
325 CALL
chkxer(
'DGESVD', infot, nout, lerr, ok )
328 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
331 WRITE( nout, fmt = 9998 )
338 CALL
dgesdd(
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
339 CALL
chkxer(
'DGESDD', infot, nout, lerr, ok )
341 CALL
dgesdd(
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
342 CALL
chkxer(
'DGESDD', infot, nout, lerr, ok )
344 CALL
dgesdd(
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
345 CALL
chkxer(
'DGESDD', infot, nout, lerr, ok )
347 CALL
dgesdd(
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
348 CALL
chkxer(
'DGESDD', infot, nout, lerr, ok )
350 CALL
dgesdd(
'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, iw, info )
351 CALL
chkxer(
'DGESDD', infot, nout, lerr, ok )
353 CALL
dgesdd(
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
354 CALL
chkxer(
'DGESDD', infot, nout, lerr, ok )
357 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
360 WRITE( nout, fmt = 9998 )
367 CALL
dgejsv(
'X',
'U',
'V',
'R',
'N',
'N',
368 $ 0, 0, a, 1, s, u, 1, vt, 1,
370 CALL
chkxer(
'DGEJSV', infot, nout, lerr, ok )
372 CALL
dgejsv(
'G',
'X',
'V',
'R',
'N',
'N',
373 $ 0, 0, a, 1, s, u, 1, vt, 1,
375 CALL
chkxer(
'DGEJSV', infot, nout, lerr, ok )
377 CALL
dgejsv(
'G',
'U',
'X',
'R',
'N',
'N',
378 $ 0, 0, a, 1, s, u, 1, vt, 1,
380 CALL
chkxer(
'DGEJSV', infot, nout, lerr, ok )
382 CALL
dgejsv(
'G',
'U',
'V',
'X',
'N',
'N',
383 $ 0, 0, a, 1, s, u, 1, vt, 1,
385 CALL
chkxer(
'DGEJSV', infot, nout, lerr, ok )
387 CALL
dgejsv(
'G',
'U',
'V',
'R',
'X',
'N',
388 $ 0, 0, a, 1, s, u, 1, vt, 1,
390 CALL
chkxer(
'DGEJSV', infot, nout, lerr, ok )
392 CALL
dgejsv(
'G',
'U',
'V',
'R',
'N',
'X',
393 $ 0, 0, a, 1, s, u, 1, vt, 1,
395 CALL
chkxer(
'DGEJSV', infot, nout, lerr, ok )
397 CALL
dgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
398 $ -1, 0, a, 1, s, u, 1, vt, 1,
400 CALL
chkxer(
'DGEJSV', infot, nout, lerr, ok )
402 CALL
dgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
403 $ 0, -1, a, 1, s, u, 1, vt, 1,
405 CALL
chkxer(
'DGEJSV', infot, nout, lerr, ok )
407 CALL
dgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
408 $ 2, 1, a, 1, s, u, 1, vt, 1,
410 CALL
chkxer(
'DGEJSV', infot, nout, lerr, ok )
412 CALL
dgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
413 $ 2, 2, a, 2, s, u, 1, vt, 2,
415 CALL
chkxer(
'DGEJSV', infot, nout, lerr, ok )
417 CALL
dgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
418 $ 2, 2, a, 2, s, u, 2, vt, 1,
420 CALL
chkxer(
'DGEJSV', infot, nout, lerr, ok )
423 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
426 WRITE( nout, fmt = 9998 )
432 IF( .NOT.
lsamen( 2, c2,
'BD' ) )
THEN
434 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
437 WRITE( nout, fmt = 9998 )
441 9999 format( 1x, a,
' passed the tests of the error exits (', i3,
443 9998 format(
' *** ', a,
' failed the tests of the error exits ***' )