56 SUBROUTINE serrhs( PATH, NUNIT )
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 ',
subroutine shsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI, VL, LDVL, VR, LDVR, MM, M, WORK, IFAILL, IFAILR, INFO)
SHSEIN
subroutine sgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SGEHRD
subroutine sgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
SGEBAK
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 chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine sgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
SGEBAL
subroutine sormhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMHR
subroutine shseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
SHSEQR
subroutine serrhs(PATH, NUNIT)
SERRHS