69 parameter( nmax = 3, lw = ( nmax+2 )*( nmax+2 )+nmax )
73 INTEGER I, ILO, IHI, INFO, J, M, NT
77 INTEGER IFAILL( NMAX ), IFAILR( NMAX )
78 REAL A( NMAX, NMAX ), C( NMAX, NMAX ), TAU( NMAX ),
79 $ VL( NMAX, NMAX ), VR( NMAX, NMAX ), W( LW ),
80 $ WI( NMAX ), WR( NMAX ), S( NMAX )
99 COMMON / infoc / infot, nout, ok, lerr
100 COMMON / srnamc / srnamt
105 WRITE( nout, fmt = * )
112 a( i, j ) = 1. / real( i+j )
122 IF( lsamen( 2, c2,
'HS' ) )
THEN
128 CALL sgebal(
'/', 0, a, 1, ilo, ihi, s, info )
129 CALL chkxer(
'SGEBAL', infot, nout, lerr, ok )
131 CALL sgebal(
'N', -1, a, 1, ilo, ihi, s, info )
132 CALL chkxer(
'SGEBAL', infot, nout, lerr, ok )
134 CALL sgebal(
'N', 2, a, 1, ilo, ihi, s, info )
135 CALL chkxer(
'SGEBAL', infot, nout, lerr, ok )
142 CALL sgebak(
'/',
'R', 0, 1, 0, s, 0, a, 1, info )
143 CALL chkxer(
'SGEBAK', infot, nout, lerr, ok )
145 CALL sgebak(
'N',
'/', 0, 1, 0, s, 0, a, 1, info )
146 CALL chkxer(
'SGEBAK', infot, nout, lerr, ok )
148 CALL sgebak(
'N',
'R', -1, 1, 0, s, 0, a, 1, info )
149 CALL chkxer(
'SGEBAK', infot, nout, lerr, ok )
151 CALL sgebak(
'N',
'R', 0, 0, 0, s, 0, a, 1, info )
152 CALL chkxer(
'SGEBAK', infot, nout, lerr, ok )
154 CALL sgebak(
'N',
'R', 0, 2, 0, s, 0, a, 1, info )
155 CALL chkxer(
'SGEBAK', infot, nout, lerr, ok )
157 CALL sgebak(
'N',
'R', 2, 2, 1, s, 0, a, 2, info )
158 CALL chkxer(
'SGEBAK', infot, nout, lerr, ok )
160 CALL sgebak(
'N',
'R', 0, 1, 1, s, 0, a, 1, info )
161 CALL chkxer(
'SGEBAK', infot, nout, lerr, ok )
163 CALL sgebak(
'N',
'R', 0, 1, 0, s, -1, a, 1, info )
164 CALL chkxer(
'SGEBAK', infot, nout, lerr, ok )
166 CALL sgebak(
'N',
'R', 2, 1, 2, s, 0, a, 1, info )
167 CALL chkxer(
'SGEBAK', infot, nout, lerr, ok )
174 CALL sgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
175 CALL chkxer(
'SGEHRD', infot, nout, lerr, ok )
177 CALL sgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
178 CALL chkxer(
'SGEHRD', infot, nout, lerr, ok )
180 CALL sgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
181 CALL chkxer(
'SGEHRD', infot, nout, lerr, ok )
183 CALL sgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
184 CALL chkxer(
'SGEHRD', infot, nout, lerr, ok )
186 CALL sgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
187 CALL chkxer(
'SGEHRD', infot, nout, lerr, ok )
189 CALL sgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
190 CALL chkxer(
'SGEHRD', infot, nout, lerr, ok )
192 CALL sgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
193 CALL chkxer(
'SGEHRD', infot, nout, lerr, ok )
200 CALL sgehd2( -1, 1, 1, a, 1, tau, w, info )
201 CALL chkxer(
'SGEHD2', infot, nout, lerr, ok )
203 CALL sgehd2( 0, 0, 0, a, 1, tau, w, info )
204 CALL chkxer(
'SGEHD2', infot, nout, lerr, ok )
206 CALL sgehd2( 0, 2, 0, a, 1, tau, w, info )
207 CALL chkxer(
'SGEHD2', infot, nout, lerr, ok )
209 CALL sgehd2( 1, 1, 0, a, 1, tau, w, info )
210 CALL chkxer(
'SGEHD2', infot, nout, lerr, ok )
212 CALL sgehd2( 0, 1, 1, a, 1, tau, w, info )
213 CALL chkxer(
'SGEHD2', infot, nout, lerr, ok )
215 CALL sgehd2( 2, 1, 1, a, 1, tau, w, info )
216 CALL chkxer(
'SGEHD2', infot, nout, lerr, ok )
223 CALL sorghr( -1, 1, 1, a, 1, tau, w, 1, info )
224 CALL chkxer(
'SORGHR', infot, nout, lerr, ok )
226 CALL sorghr( 0, 0, 0, a, 1, tau, w, 1, info )
227 CALL chkxer(
'SORGHR', infot, nout, lerr, ok )
229 CALL sorghr( 0, 2, 0, a, 1, tau, w, 1, info )
230 CALL chkxer(
'SORGHR', infot, nout, lerr, ok )
232 CALL sorghr( 1, 1, 0, a, 1, tau, w, 1, info )
233 CALL chkxer(
'SORGHR', infot, nout, lerr, ok )
235 CALL sorghr( 0, 1, 1, a, 1, tau, w, 1, info )
236 CALL chkxer(
'SORGHR', infot, nout, lerr, ok )
238 CALL sorghr( 2, 1, 1, a, 1, tau, w, 1, info )
239 CALL chkxer(
'SORGHR', infot, nout, lerr, ok )
241 CALL sorghr( 3, 1, 3, a, 3, tau, w, 1, info )
242 CALL chkxer(
'SORGHR', infot, nout, lerr, ok )
249 CALL sormhr(
'/',
'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
251 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
253 CALL sormhr(
'L',
'/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
255 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
257 CALL sormhr(
'L',
'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
259 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
261 CALL sormhr(
'L',
'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
263 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
265 CALL sormhr(
'L',
'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
267 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
269 CALL sormhr(
'L',
'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
271 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
273 CALL sormhr(
'L',
'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
275 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
277 CALL sormhr(
'R',
'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
279 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
281 CALL sormhr(
'L',
'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
283 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
285 CALL sormhr(
'L',
'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
287 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
289 CALL sormhr(
'R',
'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
291 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
293 CALL sormhr(
'L',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
295 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
297 CALL sormhr(
'R',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
299 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
301 CALL sormhr(
'L',
'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
303 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
305 CALL sormhr(
'L',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
307 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
309 CALL sormhr(
'R',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
311 CALL chkxer(
'SORMHR', infot, nout, lerr, ok )
318 CALL shseqr(
'/',
'N', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
320 CALL chkxer(
'SHSEQR', infot, nout, lerr, ok )
322 CALL shseqr(
'E',
'/', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
324 CALL chkxer(
'SHSEQR', infot, nout, lerr, ok )
326 CALL shseqr(
'E',
'N', -1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
328 CALL chkxer(
'SHSEQR', infot, nout, lerr, ok )
330 CALL shseqr(
'E',
'N', 0, 0, 0, a, 1, wr, wi, c, 1, w, 1,
332 CALL chkxer(
'SHSEQR', infot, nout, lerr, ok )
334 CALL shseqr(
'E',
'N', 0, 2, 0, a, 1, wr, wi, c, 1, w, 1,
336 CALL chkxer(
'SHSEQR', infot, nout, lerr, ok )
338 CALL shseqr(
'E',
'N', 1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
340 CALL chkxer(
'SHSEQR', infot, nout, lerr, ok )
342 CALL shseqr(
'E',
'N', 1, 1, 2, a, 1, wr, wi, c, 1, w, 1,
344 CALL chkxer(
'SHSEQR', infot, nout, lerr, ok )
346 CALL shseqr(
'E',
'N', 2, 1, 2, a, 1, wr, wi, c, 2, w, 1,
348 CALL chkxer(
'SHSEQR', infot, nout, lerr, ok )
350 CALL shseqr(
'E',
'V', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
352 CALL chkxer(
'SHSEQR', infot, nout, lerr, ok )
354 CALL shseqr(
'E',
'N', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
356 CALL chkxer(
'SHSEQR', infot, nout, lerr, ok )
363 CALL shsein(
'/',
'N',
'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
364 $ 0, m, w, ifaill, ifailr, info )
365 CALL chkxer(
'SHSEIN', infot, nout, lerr, ok )
367 CALL shsein(
'R',
'/',
'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
368 $ 0, m, w, ifaill, ifailr, info )
369 CALL chkxer(
'SHSEIN', infot, nout, lerr, ok )
371 CALL shsein(
'R',
'N',
'/', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
372 $ 0, m, w, ifaill, ifailr, info )
373 CALL chkxer(
'SHSEIN', infot, nout, lerr, ok )
375 CALL shsein(
'R',
'N',
'N', sel, -1, a, 1, wr, wi, vl, 1, vr,
376 $ 1, 0, m, w, ifaill, ifailr, info )
377 CALL chkxer(
'SHSEIN', infot, nout, lerr, ok )
379 CALL shsein(
'R',
'N',
'N', sel, 2, a, 1, wr, wi, vl, 1, vr, 2,
380 $ 4, m, w, ifaill, ifailr, info )
381 CALL chkxer(
'SHSEIN', infot, nout, lerr, ok )
383 CALL shsein(
'L',
'N',
'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
384 $ 4, m, w, ifaill, ifailr, info )
385 CALL chkxer(
'SHSEIN', infot, nout, lerr, ok )
387 CALL shsein(
'R',
'N',
'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
388 $ 4, m, w, ifaill, ifailr, info )
389 CALL chkxer(
'SHSEIN', infot, nout, lerr, ok )
391 CALL shsein(
'R',
'N',
'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 2,
392 $ 1, m, w, ifaill, ifailr, info )
393 CALL chkxer(
'SHSEIN', infot, nout, lerr, ok )
400 CALL strevc(
'/',
'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
402 CALL chkxer(
'STREVC', infot, nout, lerr, ok )
404 CALL strevc(
'L',
'/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
406 CALL chkxer(
'STREVC', infot, nout, lerr, ok )
408 CALL strevc(
'L',
'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
410 CALL chkxer(
'STREVC', infot, nout, lerr, ok )
412 CALL strevc(
'L',
'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
414 CALL chkxer(
'STREVC', infot, nout, lerr, ok )
416 CALL strevc(
'L',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
418 CALL chkxer(
'STREVC', infot, nout, lerr, ok )
420 CALL strevc(
'R',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
422 CALL chkxer(
'STREVC', infot, nout, lerr, ok )
424 CALL strevc(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
426 CALL chkxer(
'STREVC', infot, nout, lerr, ok )
433 CALL strevc3(
'/',
'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
435 CALL chkxer(
'STREVC3', infot, nout, lerr, ok )
437 CALL strevc3(
'L',
'/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
439 CALL chkxer(
'STREVC3', infot, nout, lerr, ok )
441 CALL strevc3(
'L',
'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
443 CALL chkxer(
'STREVC3', infot, nout, lerr, ok )
445 CALL strevc3(
'L',
'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
447 CALL chkxer(
'STREVC3', infot, nout, lerr, ok )
449 CALL strevc3(
'L',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
451 CALL chkxer(
'STREVC3', infot, nout, lerr, ok )
453 CALL strevc3(
'R',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
455 CALL chkxer(
'STREVC3', infot, nout, lerr, ok )
457 CALL strevc3(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
459 CALL chkxer(
'STREVC3', infot, nout, lerr, ok )
461 CALL strevc3(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
463 CALL chkxer(
'STREVC3', infot, nout, lerr, ok )
470 WRITE( nout, fmt = 9999 )path, nt
472 WRITE( nout, fmt = 9998 )path
475 9999
FORMAT( 1x, a3,
' routines passed the tests of the error exits',
476 $
' (', i3,
' tests done)' )
477 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ',