72 parameter( nmax = 3, lw = ( nmax+2 )*( nmax+2 )+nmax )
76 INTEGER i, ilo, ihi, info, j, m, nt
80 INTEGER ifaill( nmax ), ifailr( nmax )
81 REAL a( nmax, nmax ), c( nmax, nmax ), tau( nmax ),
82 $ vl( nmax, nmax ), vr( nmax, nmax ), w( lw ),
83 $ wi( nmax ), wr( nmax ), s( nmax )
102 common / infoc / infot, nout, ok, lerr
103 common / srnamc / srnamt
108 WRITE( nout, fmt = * )
115 a( i, j ) = 1. /
REAL( i+j )
125 IF(
lsamen( 2, c2,
'HS' ) )
THEN
131 CALL
sgebal(
'/', 0, a, 1, ilo, ihi, s, info )
132 CALL
chkxer(
'SGEBAL', infot, nout, lerr, ok )
134 CALL
sgebal(
'N', -1, a, 1, ilo, ihi, s, info )
135 CALL
chkxer(
'SGEBAL', infot, nout, lerr, ok )
137 CALL
sgebal(
'N', 2, a, 1, ilo, ihi, s, info )
138 CALL
chkxer(
'SGEBAL', infot, nout, lerr, ok )
145 CALL
sgebak(
'/',
'R', 0, 1, 0, s, 0, a, 1, info )
146 CALL
chkxer(
'SGEBAK', infot, nout, lerr, ok )
148 CALL
sgebak(
'N',
'/', 0, 1, 0, s, 0, a, 1, info )
149 CALL
chkxer(
'SGEBAK', infot, nout, lerr, ok )
151 CALL
sgebak(
'N',
'R', -1, 1, 0, s, 0, a, 1, info )
152 CALL
chkxer(
'SGEBAK', infot, nout, lerr, ok )
154 CALL
sgebak(
'N',
'R', 0, 0, 0, s, 0, a, 1, info )
155 CALL
chkxer(
'SGEBAK', infot, nout, lerr, ok )
157 CALL
sgebak(
'N',
'R', 0, 2, 0, s, 0, a, 1, info )
158 CALL
chkxer(
'SGEBAK', infot, nout, lerr, ok )
160 CALL
sgebak(
'N',
'R', 2, 2, 1, s, 0, a, 2, info )
161 CALL
chkxer(
'SGEBAK', infot, nout, lerr, ok )
163 CALL
sgebak(
'N',
'R', 0, 1, 1, s, 0, a, 1, info )
164 CALL
chkxer(
'SGEBAK', infot, nout, lerr, ok )
166 CALL
sgebak(
'N',
'R', 0, 1, 0, s, -1, a, 1, info )
167 CALL
chkxer(
'SGEBAK', infot, nout, lerr, ok )
169 CALL
sgebak(
'N',
'R', 2, 1, 2, s, 0, a, 1, info )
170 CALL
chkxer(
'SGEBAK', infot, nout, lerr, ok )
177 CALL
sgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
178 CALL
chkxer(
'SGEHRD', infot, nout, lerr, ok )
180 CALL
sgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
181 CALL
chkxer(
'SGEHRD', infot, nout, lerr, ok )
183 CALL
sgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
184 CALL
chkxer(
'SGEHRD', infot, nout, lerr, ok )
186 CALL
sgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
187 CALL
chkxer(
'SGEHRD', infot, nout, lerr, ok )
189 CALL
sgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
190 CALL
chkxer(
'SGEHRD', infot, nout, lerr, ok )
192 CALL
sgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
193 CALL
chkxer(
'SGEHRD', infot, nout, lerr, ok )
195 CALL
sgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
196 CALL
chkxer(
'SGEHRD', infot, nout, lerr, ok )
203 CALL
sorghr( -1, 1, 1, a, 1, tau, w, 1, info )
204 CALL
chkxer(
'SORGHR', infot, nout, lerr, ok )
206 CALL
sorghr( 0, 0, 0, a, 1, tau, w, 1, info )
207 CALL
chkxer(
'SORGHR', infot, nout, lerr, ok )
209 CALL
sorghr( 0, 2, 0, a, 1, tau, w, 1, info )
210 CALL
chkxer(
'SORGHR', infot, nout, lerr, ok )
212 CALL
sorghr( 1, 1, 0, a, 1, tau, w, 1, info )
213 CALL
chkxer(
'SORGHR', infot, nout, lerr, ok )
215 CALL
sorghr( 0, 1, 1, a, 1, tau, w, 1, info )
216 CALL
chkxer(
'SORGHR', infot, nout, lerr, ok )
218 CALL
sorghr( 2, 1, 1, a, 1, tau, w, 1, info )
219 CALL
chkxer(
'SORGHR', infot, nout, lerr, ok )
221 CALL
sorghr( 3, 1, 3, a, 3, tau, w, 1, info )
222 CALL
chkxer(
'SORGHR', infot, nout, lerr, ok )
229 CALL
sormhr(
'/',
'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
231 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
233 CALL
sormhr(
'L',
'/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
235 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
237 CALL
sormhr(
'L',
'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
239 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
241 CALL
sormhr(
'L',
'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
243 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
245 CALL
sormhr(
'L',
'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
247 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
249 CALL
sormhr(
'L',
'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
251 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
253 CALL
sormhr(
'L',
'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
255 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
257 CALL
sormhr(
'R',
'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
259 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
261 CALL
sormhr(
'L',
'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
263 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
265 CALL
sormhr(
'L',
'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
267 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
269 CALL
sormhr(
'R',
'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
271 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
273 CALL
sormhr(
'L',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
275 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
277 CALL
sormhr(
'R',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
279 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
281 CALL
sormhr(
'L',
'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
283 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
285 CALL
sormhr(
'L',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
287 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
289 CALL
sormhr(
'R',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
291 CALL
chkxer(
'SORMHR', infot, nout, lerr, ok )
298 CALL
shseqr(
'/',
'N', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
300 CALL
chkxer(
'SHSEQR', infot, nout, lerr, ok )
302 CALL
shseqr(
'E',
'/', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
304 CALL
chkxer(
'SHSEQR', infot, nout, lerr, ok )
306 CALL
shseqr(
'E',
'N', -1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
308 CALL
chkxer(
'SHSEQR', infot, nout, lerr, ok )
310 CALL
shseqr(
'E',
'N', 0, 0, 0, a, 1, wr, wi, c, 1, w, 1,
312 CALL
chkxer(
'SHSEQR', infot, nout, lerr, ok )
314 CALL
shseqr(
'E',
'N', 0, 2, 0, a, 1, wr, wi, c, 1, w, 1,
316 CALL
chkxer(
'SHSEQR', infot, nout, lerr, ok )
318 CALL
shseqr(
'E',
'N', 1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
320 CALL
chkxer(
'SHSEQR', infot, nout, lerr, ok )
322 CALL
shseqr(
'E',
'N', 1, 1, 2, a, 1, wr, wi, c, 1, w, 1,
324 CALL
chkxer(
'SHSEQR', infot, nout, lerr, ok )
326 CALL
shseqr(
'E',
'N', 2, 1, 2, a, 1, wr, wi, c, 2, w, 1,
328 CALL
chkxer(
'SHSEQR', infot, nout, lerr, ok )
330 CALL
shseqr(
'E',
'V', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
332 CALL
chkxer(
'SHSEQR', infot, nout, lerr, ok )
339 CALL
shsein(
'/',
'N',
'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
340 $ 0, m, w, ifaill, ifailr, info )
341 CALL
chkxer(
'SHSEIN', infot, nout, lerr, ok )
343 CALL
shsein(
'R',
'/',
'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
344 $ 0, m, w, ifaill, ifailr, info )
345 CALL
chkxer(
'SHSEIN', infot, nout, lerr, ok )
347 CALL
shsein(
'R',
'N',
'/', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
348 $ 0, m, w, ifaill, ifailr, info )
349 CALL
chkxer(
'SHSEIN', infot, nout, lerr, ok )
351 CALL
shsein(
'R',
'N',
'N', sel, -1, a, 1, wr, wi, vl, 1, vr,
352 $ 1, 0, m, w, ifaill, ifailr, info )
353 CALL
chkxer(
'SHSEIN', infot, nout, lerr, ok )
355 CALL
shsein(
'R',
'N',
'N', sel, 2, a, 1, wr, wi, vl, 1, vr, 2,
356 $ 4, m, w, ifaill, ifailr, info )
357 CALL
chkxer(
'SHSEIN', infot, nout, lerr, ok )
359 CALL
shsein(
'L',
'N',
'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
360 $ 4, m, w, ifaill, ifailr, info )
361 CALL
chkxer(
'SHSEIN', infot, nout, lerr, ok )
363 CALL
shsein(
'R',
'N',
'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
364 $ 4, m, w, ifaill, ifailr, info )
365 CALL
chkxer(
'SHSEIN', infot, nout, lerr, ok )
367 CALL
shsein(
'R',
'N',
'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 2,
368 $ 1, m, w, ifaill, ifailr, info )
369 CALL
chkxer(
'SHSEIN', infot, nout, lerr, ok )
376 CALL
strevc(
'/',
'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
378 CALL
chkxer(
'STREVC', infot, nout, lerr, ok )
380 CALL
strevc(
'L',
'/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
382 CALL
chkxer(
'STREVC', infot, nout, lerr, ok )
384 CALL
strevc(
'L',
'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
386 CALL
chkxer(
'STREVC', infot, nout, lerr, ok )
388 CALL
strevc(
'L',
'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
390 CALL
chkxer(
'STREVC', infot, nout, lerr, ok )
392 CALL
strevc(
'L',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
394 CALL
chkxer(
'STREVC', infot, nout, lerr, ok )
396 CALL
strevc(
'R',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
398 CALL
chkxer(
'STREVC', infot, nout, lerr, ok )
400 CALL
strevc(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
402 CALL
chkxer(
'STREVC', infot, nout, lerr, ok )
409 WRITE( nout, fmt = 9999 )path, nt
411 WRITE( nout, fmt = 9998 )path
414 9999 format( 1x, a3,
' routines passed the tests of the error exits',
415 $
' (', i3,
' tests done)' )
416 9998 format(
' *** ', a3,
' routines failed the tests of the error ',