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 ',
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine sgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
SGEBAK
subroutine sgebal(job, n, a, lda, ilo, ihi, scale, info)
SGEBAL
subroutine sgehd2(n, ilo, ihi, a, lda, tau, work, info)
SGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm.
subroutine sgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
SGEHRD
subroutine shsein(side, eigsrc, initv, select, n, h, ldh, wr, wi, vl, ldvl, vr, ldvr, mm, m, work, ifaill, ifailr, info)
SHSEIN
subroutine shseqr(job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork, info)
SHSEQR
subroutine strevc3(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, lwork, info)
STREVC3
subroutine strevc(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, info)
STREVC
subroutine sorghr(n, ilo, ihi, a, lda, tau, work, lwork, info)
SORGHR
subroutine sormhr(side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork, info)
SORMHR
subroutine serrhs(path, nunit)
SERRHS