72 parameter( nmax = 3, lw = nmax*nmax )
76 INTEGER i, ihi, ilo, info,
j, m, nt
80 INTEGER ifaill( nmax ), ifailr( nmax )
81 DOUBLE PRECISION rw( nmax ), s( nmax )
82 COMPLEX*16 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.d0 / dble( i+
j )
125 IF(
lsamen( 2, c2,
'HS' ) )
THEN
131 CALL
zgebal(
'/', 0, a, 1, ilo, ihi, s, info )
132 CALL
chkxer(
'ZGEBAL', infot, nout, lerr, ok )
134 CALL
zgebal(
'N', -1, a, 1, ilo, ihi, s, info )
135 CALL
chkxer(
'ZGEBAL', infot, nout, lerr, ok )
137 CALL
zgebal(
'N', 2, a, 1, ilo, ihi, s, info )
138 CALL
chkxer(
'ZGEBAL', infot, nout, lerr, ok )
145 CALL
zgebak(
'/',
'R', 0, 1, 0, s, 0, a, 1, info )
146 CALL
chkxer(
'ZGEBAK', infot, nout, lerr, ok )
148 CALL
zgebak(
'N',
'/', 0, 1, 0, s, 0, a, 1, info )
149 CALL
chkxer(
'ZGEBAK', infot, nout, lerr, ok )
151 CALL
zgebak(
'N',
'R', -1, 1, 0, s, 0, a, 1, info )
152 CALL
chkxer(
'ZGEBAK', infot, nout, lerr, ok )
154 CALL
zgebak(
'N',
'R', 0, 0, 0, s, 0, a, 1, info )
155 CALL
chkxer(
'ZGEBAK', infot, nout, lerr, ok )
157 CALL
zgebak(
'N',
'R', 0, 2, 0, s, 0, a, 1, info )
158 CALL
chkxer(
'ZGEBAK', infot, nout, lerr, ok )
160 CALL
zgebak(
'N',
'R', 2, 2, 1, s, 0, a, 2, info )
161 CALL
chkxer(
'ZGEBAK', infot, nout, lerr, ok )
163 CALL
zgebak(
'N',
'R', 0, 1, 1, s, 0, a, 1, info )
164 CALL
chkxer(
'ZGEBAK', infot, nout, lerr, ok )
166 CALL
zgebak(
'N',
'R', 0, 1, 0, s, -1, a, 1, info )
167 CALL
chkxer(
'ZGEBAK', infot, nout, lerr, ok )
169 CALL
zgebak(
'N',
'R', 2, 1, 2, s, 0, a, 1, info )
170 CALL
chkxer(
'ZGEBAK', infot, nout, lerr, ok )
177 CALL
zgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
178 CALL
chkxer(
'ZGEHRD', infot, nout, lerr, ok )
180 CALL
zgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
181 CALL
chkxer(
'ZGEHRD', infot, nout, lerr, ok )
183 CALL
zgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
184 CALL
chkxer(
'ZGEHRD', infot, nout, lerr, ok )
186 CALL
zgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
187 CALL
chkxer(
'ZGEHRD', infot, nout, lerr, ok )
189 CALL
zgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
190 CALL
chkxer(
'ZGEHRD', infot, nout, lerr, ok )
192 CALL
zgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
193 CALL
chkxer(
'ZGEHRD', infot, nout, lerr, ok )
195 CALL
zgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
196 CALL
chkxer(
'ZGEHRD', infot, nout, lerr, ok )
203 CALL
zunghr( -1, 1, 1, a, 1, tau, w, 1, info )
204 CALL
chkxer(
'ZUNGHR', infot, nout, lerr, ok )
206 CALL
zunghr( 0, 0, 0, a, 1, tau, w, 1, info )
207 CALL
chkxer(
'ZUNGHR', infot, nout, lerr, ok )
209 CALL
zunghr( 0, 2, 0, a, 1, tau, w, 1, info )
210 CALL
chkxer(
'ZUNGHR', infot, nout, lerr, ok )
212 CALL
zunghr( 1, 1, 0, a, 1, tau, w, 1, info )
213 CALL
chkxer(
'ZUNGHR', infot, nout, lerr, ok )
215 CALL
zunghr( 0, 1, 1, a, 1, tau, w, 1, info )
216 CALL
chkxer(
'ZUNGHR', infot, nout, lerr, ok )
218 CALL
zunghr( 2, 1, 1, a, 1, tau, w, 1, info )
219 CALL
chkxer(
'ZUNGHR', infot, nout, lerr, ok )
221 CALL
zunghr( 3, 1, 3, a, 3, tau, w, 1, info )
222 CALL
chkxer(
'ZUNGHR', infot, nout, lerr, ok )
229 CALL
zunmhr(
'/',
'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
231 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
233 CALL
zunmhr(
'L',
'/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
235 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
237 CALL
zunmhr(
'L',
'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
239 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
241 CALL
zunmhr(
'L',
'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
243 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
245 CALL
zunmhr(
'L',
'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
247 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
249 CALL
zunmhr(
'L',
'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
251 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
253 CALL
zunmhr(
'L',
'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
255 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
257 CALL
zunmhr(
'R',
'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
259 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
261 CALL
zunmhr(
'L',
'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
263 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
265 CALL
zunmhr(
'L',
'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
267 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
269 CALL
zunmhr(
'R',
'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
271 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
273 CALL
zunmhr(
'L',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
275 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
277 CALL
zunmhr(
'R',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
279 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
281 CALL
zunmhr(
'L',
'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
283 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
285 CALL
zunmhr(
'L',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
287 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
289 CALL
zunmhr(
'R',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
291 CALL
chkxer(
'ZUNMHR', infot, nout, lerr, ok )
298 CALL
zhseqr(
'/',
'N', 0, 1, 0, a, 1, x, c, 1, w, 1, info )
299 CALL
chkxer(
'ZHSEQR', infot, nout, lerr, ok )
301 CALL
zhseqr(
'E',
'/', 0, 1, 0, a, 1, x, c, 1, w, 1, info )
302 CALL
chkxer(
'ZHSEQR', infot, nout, lerr, ok )
304 CALL
zhseqr(
'E',
'N', -1, 1, 0, a, 1, x, c, 1, w, 1, info )
305 CALL
chkxer(
'ZHSEQR', infot, nout, lerr, ok )
307 CALL
zhseqr(
'E',
'N', 0, 0, 0, a, 1, x, c, 1, w, 1, info )
308 CALL
chkxer(
'ZHSEQR', infot, nout, lerr, ok )
310 CALL
zhseqr(
'E',
'N', 0, 2, 0, a, 1, x, c, 1, w, 1, info )
311 CALL
chkxer(
'ZHSEQR', infot, nout, lerr, ok )
313 CALL
zhseqr(
'E',
'N', 1, 1, 0, a, 1, x, c, 1, w, 1, info )
314 CALL
chkxer(
'ZHSEQR', infot, nout, lerr, ok )
316 CALL
zhseqr(
'E',
'N', 1, 1, 2, a, 1, x, c, 1, w, 1, info )
317 CALL
chkxer(
'ZHSEQR', infot, nout, lerr, ok )
319 CALL
zhseqr(
'E',
'N', 2, 1, 2, a, 1, x, c, 2, w, 1, info )
320 CALL
chkxer(
'ZHSEQR', infot, nout, lerr, ok )
322 CALL
zhseqr(
'E',
'V', 2, 1, 2, a, 2, x, c, 1, w, 1, info )
323 CALL
chkxer(
'ZHSEQR', infot, nout, lerr, ok )
330 CALL
zhsein(
'/',
'N',
'N', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
331 $ m, w, rw, ifaill, ifailr, info )
332 CALL
chkxer(
'ZHSEIN', infot, nout, lerr, ok )
334 CALL
zhsein(
'R',
'/',
'N', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
335 $ m, w, rw, ifaill, ifailr, info )
336 CALL
chkxer(
'ZHSEIN', infot, nout, lerr, ok )
338 CALL
zhsein(
'R',
'N',
'/', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
339 $ m, w, rw, ifaill, ifailr, info )
340 CALL
chkxer(
'ZHSEIN', infot, nout, lerr, ok )
342 CALL
zhsein(
'R',
'N',
'N', sel, -1, a, 1, x, vl, 1, vr, 1, 0,
343 $ m, w, rw, ifaill, ifailr, info )
344 CALL
chkxer(
'ZHSEIN', infot, nout, lerr, ok )
346 CALL
zhsein(
'R',
'N',
'N', sel, 2, a, 1, x, vl, 1, vr, 2, 4,
347 $ m, w, rw, ifaill, ifailr, info )
348 CALL
chkxer(
'ZHSEIN', infot, nout, lerr, ok )
350 CALL
zhsein(
'L',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 1, 4,
351 $ m, w, rw, ifaill, ifailr, info )
352 CALL
chkxer(
'ZHSEIN', infot, nout, lerr, ok )
354 CALL
zhsein(
'R',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 1, 4,
355 $ m, w, rw, ifaill, ifailr, info )
356 CALL
chkxer(
'ZHSEIN', infot, nout, lerr, ok )
358 CALL
zhsein(
'R',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 2, 1,
359 $ m, w, rw, ifaill, ifailr, info )
360 CALL
chkxer(
'ZHSEIN', infot, nout, lerr, ok )
367 CALL
ztrevc(
'/',
'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w, rw,
369 CALL
chkxer(
'ZTREVC', infot, nout, lerr, ok )
371 CALL
ztrevc(
'L',
'/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w, rw,
373 CALL
chkxer(
'ZTREVC', infot, nout, lerr, ok )
375 CALL
ztrevc(
'L',
'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
377 CALL
chkxer(
'ZTREVC', infot, nout, lerr, ok )
379 CALL
ztrevc(
'L',
'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w, rw,
381 CALL
chkxer(
'ZTREVC', infot, nout, lerr, ok )
383 CALL
ztrevc(
'L',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w, rw,
385 CALL
chkxer(
'ZTREVC', infot, nout, lerr, ok )
387 CALL
ztrevc(
'R',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w, rw,
389 CALL
chkxer(
'ZTREVC', infot, nout, lerr, ok )
391 CALL
ztrevc(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w, rw,
393 CALL
chkxer(
'ZTREVC', infot, nout, lerr, ok )
400 WRITE( nout, fmt = 9999 )path, nt
402 WRITE( nout, fmt = 9998 )path
405 9999
FORMAT( 1x, a3,
' routines passed the tests of the error exits',
406 $
' (', i3,
' tests done)' )
407 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ',
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
subroutine ztrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
ZTREVC
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
subroutine zerrhs(PATH, NUNIT)
ZERRHS
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine zgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZGEHRD
subroutine zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
logical function lsamen(N, CA, CB)
LSAMEN
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zhsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL, IFAILR, INFO)
ZHSEIN
subroutine zunmhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMHR
subroutine zgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
ZGEBAK