72 parameter( nmax = 3, lw = nmax*nmax )
76 INTEGER i, ihi, ilo, info,
j, m, nt
80 INTEGER ifaill( nmax ), ifailr( nmax )
81 REAL rw( nmax ), s( nmax )
82 COMPLEX a( nmax, nmax ), c( nmax, nmax ), tau( nmax ),
83 $ vl( nmax, nmax ), vr( nmax, nmax ), w( lw ),
103 COMMON / infoc / infot, nout, ok, lerr
104 COMMON / srnamc / srnamt
109 WRITE( nout, fmt = * )
116 a( i,
j ) = 1. /
REAL( i+
j )
125 IF(
lsamen( 2, c2,
'HS' ) )
THEN
131 CALL
cgebal(
'/', 0, a, 1, ilo, ihi, s, info )
132 CALL
chkxer(
'CGEBAL', infot, nout, lerr, ok )
134 CALL
cgebal(
'N', -1, a, 1, ilo, ihi, s, info )
135 CALL
chkxer(
'CGEBAL', infot, nout, lerr, ok )
137 CALL
cgebal(
'N', 2, a, 1, ilo, ihi, s, info )
138 CALL
chkxer(
'CGEBAL', infot, nout, lerr, ok )
145 CALL
cgebak(
'/',
'R', 0, 1, 0, s, 0, a, 1, info )
146 CALL
chkxer(
'CGEBAK', infot, nout, lerr, ok )
148 CALL
cgebak(
'N',
'/', 0, 1, 0, s, 0, a, 1, info )
149 CALL
chkxer(
'CGEBAK', infot, nout, lerr, ok )
151 CALL
cgebak(
'N',
'R', -1, 1, 0, s, 0, a, 1, info )
152 CALL
chkxer(
'CGEBAK', infot, nout, lerr, ok )
154 CALL
cgebak(
'N',
'R', 0, 0, 0, s, 0, a, 1, info )
155 CALL
chkxer(
'CGEBAK', infot, nout, lerr, ok )
157 CALL
cgebak(
'N',
'R', 0, 2, 0, s, 0, a, 1, info )
158 CALL
chkxer(
'CGEBAK', infot, nout, lerr, ok )
160 CALL
cgebak(
'N',
'R', 2, 2, 1, s, 0, a, 2, info )
161 CALL
chkxer(
'CGEBAK', infot, nout, lerr, ok )
163 CALL
cgebak(
'N',
'R', 0, 1, 1, s, 0, a, 1, info )
164 CALL
chkxer(
'CGEBAK', infot, nout, lerr, ok )
166 CALL
cgebak(
'N',
'R', 0, 1, 0, s, -1, a, 1, info )
167 CALL
chkxer(
'CGEBAK', infot, nout, lerr, ok )
169 CALL
cgebak(
'N',
'R', 2, 1, 2, s, 0, a, 1, info )
170 CALL
chkxer(
'CGEBAK', infot, nout, lerr, ok )
177 CALL
cgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
178 CALL
chkxer(
'CGEHRD', infot, nout, lerr, ok )
180 CALL
cgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
181 CALL
chkxer(
'CGEHRD', infot, nout, lerr, ok )
183 CALL
cgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
184 CALL
chkxer(
'CGEHRD', infot, nout, lerr, ok )
186 CALL
cgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
187 CALL
chkxer(
'CGEHRD', infot, nout, lerr, ok )
189 CALL
cgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
190 CALL
chkxer(
'CGEHRD', infot, nout, lerr, ok )
192 CALL
cgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
193 CALL
chkxer(
'CGEHRD', infot, nout, lerr, ok )
195 CALL
cgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
196 CALL
chkxer(
'CGEHRD', infot, nout, lerr, ok )
203 CALL
cunghr( -1, 1, 1, a, 1, tau, w, 1, info )
204 CALL
chkxer(
'CUNGHR', infot, nout, lerr, ok )
206 CALL
cunghr( 0, 0, 0, a, 1, tau, w, 1, info )
207 CALL
chkxer(
'CUNGHR', infot, nout, lerr, ok )
209 CALL
cunghr( 0, 2, 0, a, 1, tau, w, 1, info )
210 CALL
chkxer(
'CUNGHR', infot, nout, lerr, ok )
212 CALL
cunghr( 1, 1, 0, a, 1, tau, w, 1, info )
213 CALL
chkxer(
'CUNGHR', infot, nout, lerr, ok )
215 CALL
cunghr( 0, 1, 1, a, 1, tau, w, 1, info )
216 CALL
chkxer(
'CUNGHR', infot, nout, lerr, ok )
218 CALL
cunghr( 2, 1, 1, a, 1, tau, w, 1, info )
219 CALL
chkxer(
'CUNGHR', infot, nout, lerr, ok )
221 CALL
cunghr( 3, 1, 3, a, 3, tau, w, 1, info )
222 CALL
chkxer(
'CUNGHR', infot, nout, lerr, ok )
229 CALL
cunmhr(
'/',
'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
231 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
233 CALL
cunmhr(
'L',
'/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
235 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
237 CALL
cunmhr(
'L',
'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
239 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
241 CALL
cunmhr(
'L',
'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
243 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
245 CALL
cunmhr(
'L',
'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
247 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
249 CALL
cunmhr(
'L',
'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
251 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
253 CALL
cunmhr(
'L',
'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
255 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
257 CALL
cunmhr(
'R',
'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
259 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
261 CALL
cunmhr(
'L',
'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
263 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
265 CALL
cunmhr(
'L',
'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
267 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
269 CALL
cunmhr(
'R',
'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
271 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
273 CALL
cunmhr(
'L',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
275 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
277 CALL
cunmhr(
'R',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
279 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
281 CALL
cunmhr(
'L',
'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
283 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
285 CALL
cunmhr(
'L',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
287 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
289 CALL
cunmhr(
'R',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
291 CALL
chkxer(
'CUNMHR', infot, nout, lerr, ok )
298 CALL
chseqr(
'/',
'N', 0, 1, 0, a, 1, x, c, 1, w, 1,
300 CALL
chkxer(
'CHSEQR', infot, nout, lerr, ok )
302 CALL
chseqr(
'E',
'/', 0, 1, 0, a, 1, x, c, 1, w, 1,
304 CALL
chkxer(
'CHSEQR', infot, nout, lerr, ok )
306 CALL
chseqr(
'E',
'N', -1, 1, 0, a, 1, x, c, 1, w, 1,
308 CALL
chkxer(
'CHSEQR', infot, nout, lerr, ok )
310 CALL
chseqr(
'E',
'N', 0, 0, 0, a, 1, x, c, 1, w, 1,
312 CALL
chkxer(
'CHSEQR', infot, nout, lerr, ok )
314 CALL
chseqr(
'E',
'N', 0, 2, 0, a, 1, x, c, 1, w, 1,
316 CALL
chkxer(
'CHSEQR', infot, nout, lerr, ok )
318 CALL
chseqr(
'E',
'N', 1, 1, 0, a, 1, x, c, 1, w, 1,
320 CALL
chkxer(
'CHSEQR', infot, nout, lerr, ok )
322 CALL
chseqr(
'E',
'N', 1, 1, 2, a, 1, x, c, 1, w, 1,
324 CALL
chkxer(
'CHSEQR', infot, nout, lerr, ok )
326 CALL
chseqr(
'E',
'N', 2, 1, 2, a, 1, x, c, 2, w, 1,
328 CALL
chkxer(
'CHSEQR', infot, nout, lerr, ok )
330 CALL
chseqr(
'E',
'V', 2, 1, 2, a, 2, x, c, 1, w, 1,
332 CALL
chkxer(
'CHSEQR', infot, nout, lerr, ok )
339 CALL
chsein(
'/',
'N',
'N', sel, 0, a, 1, x, vl, 1, vr, 1,
340 $ 0, m, w, rw, ifaill, ifailr, info )
341 CALL
chkxer(
'CHSEIN', infot, nout, lerr, ok )
343 CALL
chsein(
'R',
'/',
'N', sel, 0, a, 1, x, vl, 1, vr, 1,
344 $ 0, m, w, rw, ifaill, ifailr, info )
345 CALL
chkxer(
'CHSEIN', infot, nout, lerr, ok )
347 CALL
chsein(
'R',
'N',
'/', sel, 0, a, 1, x, vl, 1, vr, 1,
348 $ 0, m, w, rw, ifaill, ifailr, info )
349 CALL
chkxer(
'CHSEIN', infot, nout, lerr, ok )
351 CALL
chsein(
'R',
'N',
'N', sel, -1, a, 1, x, vl, 1, vr,
352 $ 1, 0, m, w, rw, ifaill, ifailr, info )
353 CALL
chkxer(
'CHSEIN', infot, nout, lerr, ok )
355 CALL
chsein(
'R',
'N',
'N', sel, 2, a, 1, x, vl, 1, vr, 2,
356 $ 4, m, w, rw, ifaill, ifailr, info )
357 CALL
chkxer(
'CHSEIN', infot, nout, lerr, ok )
359 CALL
chsein(
'L',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 1,
360 $ 4, m, w, rw, ifaill, ifailr, info )
361 CALL
chkxer(
'CHSEIN', infot, nout, lerr, ok )
363 CALL
chsein(
'R',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 1,
364 $ 4, m, w, rw, ifaill, ifailr, info )
365 CALL
chkxer(
'CHSEIN', infot, nout, lerr, ok )
367 CALL
chsein(
'R',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 2,
368 $ 1, m, w, rw, ifaill, ifailr, info )
369 CALL
chkxer(
'CHSEIN', infot, nout, lerr, ok )
376 CALL
ctrevc(
'/',
'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
378 CALL
chkxer(
'CTREVC', infot, nout, lerr, ok )
380 CALL
ctrevc(
'L',
'/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
382 CALL
chkxer(
'CTREVC', infot, nout, lerr, ok )
384 CALL
ctrevc(
'L',
'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
386 CALL
chkxer(
'CTREVC', infot, nout, lerr, ok )
388 CALL
ctrevc(
'L',
'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
390 CALL
chkxer(
'CTREVC', infot, nout, lerr, ok )
392 CALL
ctrevc(
'L',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
394 CALL
chkxer(
'CTREVC', infot, nout, lerr, ok )
396 CALL
ctrevc(
'R',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
398 CALL
chkxer(
'CTREVC', infot, nout, lerr, ok )
400 CALL
ctrevc(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
402 CALL
chkxer(
'CTREVC', 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 chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine cunmhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMHR
subroutine cgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
CGEBAL
logical function lsamen(N, CA, CB)
LSAMEN
subroutine chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cerrhs(PATH, NUNIT)
CERRHS
subroutine cgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CGEHRD
subroutine cgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
CGEBAK
subroutine ctrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
CTREVC
subroutine chsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL, IFAILR, INFO)
CHSEIN
subroutine cunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CUNGHR