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 serrhs(PATH, NUNIT)
SERRHS
subroutine sgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
SGEBAK
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine shseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
SHSEQR
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
logical function lsamen(N, CA, CB)
LSAMEN
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine sorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SORGHR
subroutine strevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
STREVC
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