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 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
subroutine ztrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
ZTREVC
subroutine zgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZGEHRD
subroutine zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
logical function lsamen(N, CA, CB)
LSAMEN
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
subroutine zhsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL, IFAILR, INFO)
ZHSEIN
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR