69 parameter( nmax = 3, lw = nmax*nmax )
73 INTEGER I, IHI, ILO, INFO, J, M, NT
77 INTEGER IFAILL( NMAX ), IFAILR( NMAX )
78 DOUBLE PRECISION RW( NMAX ), S( NMAX )
79 COMPLEX*16 A( NMAX, NMAX ), C( NMAX, NMAX ), TAU( NMAX ),
80 $ VL( NMAX, NMAX ), VR( NMAX, NMAX ), W( LW ),
100 COMMON / infoc / infot, nout, ok, lerr
101 COMMON / srnamc / srnamt
106 WRITE( nout, fmt = * )
113 a( i, j ) = 1.d0 / dble( i+j )
122 IF( lsamen( 2, c2,
'HS' ) )
THEN
128 CALL zgebal(
'/', 0, a, 1, ilo, ihi, s, info )
129 CALL chkxer(
'ZGEBAL', infot, nout, lerr, ok )
131 CALL zgebal(
'N', -1, a, 1, ilo, ihi, s, info )
132 CALL chkxer(
'ZGEBAL', infot, nout, lerr, ok )
134 CALL zgebal(
'N', 2, a, 1, ilo, ihi, s, info )
135 CALL chkxer(
'ZGEBAL', infot, nout, lerr, ok )
142 CALL zgebak(
'/',
'R', 0, 1, 0, s, 0, a, 1, info )
143 CALL chkxer(
'ZGEBAK', infot, nout, lerr, ok )
145 CALL zgebak(
'N',
'/', 0, 1, 0, s, 0, a, 1, info )
146 CALL chkxer(
'ZGEBAK', infot, nout, lerr, ok )
148 CALL zgebak(
'N',
'R', -1, 1, 0, s, 0, a, 1, info )
149 CALL chkxer(
'ZGEBAK', infot, nout, lerr, ok )
151 CALL zgebak(
'N',
'R', 0, 0, 0, s, 0, a, 1, info )
152 CALL chkxer(
'ZGEBAK', infot, nout, lerr, ok )
154 CALL zgebak(
'N',
'R', 0, 2, 0, s, 0, a, 1, info )
155 CALL chkxer(
'ZGEBAK', infot, nout, lerr, ok )
157 CALL zgebak(
'N',
'R', 2, 2, 1, s, 0, a, 2, info )
158 CALL chkxer(
'ZGEBAK', infot, nout, lerr, ok )
160 CALL zgebak(
'N',
'R', 0, 1, 1, s, 0, a, 1, info )
161 CALL chkxer(
'ZGEBAK', infot, nout, lerr, ok )
163 CALL zgebak(
'N',
'R', 0, 1, 0, s, -1, a, 1, info )
164 CALL chkxer(
'ZGEBAK', infot, nout, lerr, ok )
166 CALL zgebak(
'N',
'R', 2, 1, 2, s, 0, a, 1, info )
167 CALL chkxer(
'ZGEBAK', infot, nout, lerr, ok )
174 CALL zgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
175 CALL chkxer(
'ZGEHRD', infot, nout, lerr, ok )
177 CALL zgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
178 CALL chkxer(
'ZGEHRD', infot, nout, lerr, ok )
180 CALL zgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
181 CALL chkxer(
'ZGEHRD', infot, nout, lerr, ok )
183 CALL zgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
184 CALL chkxer(
'ZGEHRD', infot, nout, lerr, ok )
186 CALL zgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
187 CALL chkxer(
'ZGEHRD', infot, nout, lerr, ok )
189 CALL zgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
190 CALL chkxer(
'ZGEHRD', infot, nout, lerr, ok )
192 CALL zgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
193 CALL chkxer(
'ZGEHRD', infot, nout, lerr, ok )
200 CALL zgehd2( -1, 1, 1, a, 1, tau, w, info )
201 CALL chkxer(
'ZGEHD2', infot, nout, lerr, ok )
203 CALL zgehd2( 0, 0, 0, a, 1, tau, w, info )
204 CALL chkxer(
'ZGEHD2', infot, nout, lerr, ok )
206 CALL zgehd2( 0, 2, 0, a, 1, tau, w, info )
207 CALL chkxer(
'ZGEHD2', infot, nout, lerr, ok )
209 CALL zgehd2( 1, 1, 0, a, 1, tau, w, info )
210 CALL chkxer(
'ZGEHD2', infot, nout, lerr, ok )
212 CALL zgehd2( 0, 1, 1, a, 1, tau, w, info )
213 CALL chkxer(
'ZGEHD2', infot, nout, lerr, ok )
215 CALL zgehd2( 2, 1, 1, a, 1, tau, w, info )
216 CALL chkxer(
'ZGEHD2', infot, nout, lerr, ok )
223 CALL zunghr( -1, 1, 1, a, 1, tau, w, 1, info )
224 CALL chkxer(
'ZUNGHR', infot, nout, lerr, ok )
226 CALL zunghr( 0, 0, 0, a, 1, tau, w, 1, info )
227 CALL chkxer(
'ZUNGHR', infot, nout, lerr, ok )
229 CALL zunghr( 0, 2, 0, a, 1, tau, w, 1, info )
230 CALL chkxer(
'ZUNGHR', infot, nout, lerr, ok )
232 CALL zunghr( 1, 1, 0, a, 1, tau, w, 1, info )
233 CALL chkxer(
'ZUNGHR', infot, nout, lerr, ok )
235 CALL zunghr( 0, 1, 1, a, 1, tau, w, 1, info )
236 CALL chkxer(
'ZUNGHR', infot, nout, lerr, ok )
238 CALL zunghr( 2, 1, 1, a, 1, tau, w, 1, info )
239 CALL chkxer(
'ZUNGHR', infot, nout, lerr, ok )
241 CALL zunghr( 3, 1, 3, a, 3, tau, w, 1, info )
242 CALL chkxer(
'ZUNGHR', infot, nout, lerr, ok )
249 CALL zunmhr(
'/',
'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
251 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
253 CALL zunmhr(
'L',
'/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
255 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
257 CALL zunmhr(
'L',
'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
259 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
261 CALL zunmhr(
'L',
'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
263 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
265 CALL zunmhr(
'L',
'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
267 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
269 CALL zunmhr(
'L',
'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
271 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
273 CALL zunmhr(
'L',
'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
275 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
277 CALL zunmhr(
'R',
'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
279 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
281 CALL zunmhr(
'L',
'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
283 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
285 CALL zunmhr(
'L',
'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
287 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
289 CALL zunmhr(
'R',
'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
291 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
293 CALL zunmhr(
'L',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
295 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
297 CALL zunmhr(
'R',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
299 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
301 CALL zunmhr(
'L',
'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
303 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
305 CALL zunmhr(
'L',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
307 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
309 CALL zunmhr(
'R',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
311 CALL chkxer(
'ZUNMHR', infot, nout, lerr, ok )
318 CALL zhseqr(
'/',
'N', 0, 1, 0, a, 1, x, c, 1, w, 1, info )
319 CALL chkxer(
'ZHSEQR', infot, nout, lerr, ok )
321 CALL zhseqr(
'E',
'/', 0, 1, 0, a, 1, x, c, 1, w, 1, info )
322 CALL chkxer(
'ZHSEQR', infot, nout, lerr, ok )
324 CALL zhseqr(
'E',
'N', -1, 1, 0, a, 1, x, c, 1, w, 1, info )
325 CALL chkxer(
'ZHSEQR', infot, nout, lerr, ok )
327 CALL zhseqr(
'E',
'N', 0, 0, 0, a, 1, x, c, 1, w, 1, info )
328 CALL chkxer(
'ZHSEQR', infot, nout, lerr, ok )
330 CALL zhseqr(
'E',
'N', 0, 2, 0, a, 1, x, c, 1, w, 1, info )
331 CALL chkxer(
'ZHSEQR', infot, nout, lerr, ok )
333 CALL zhseqr(
'E',
'N', 1, 1, 0, a, 1, x, c, 1, w, 1, info )
334 CALL chkxer(
'ZHSEQR', infot, nout, lerr, ok )
336 CALL zhseqr(
'E',
'N', 1, 1, 2, a, 1, x, c, 1, w, 1, info )
337 CALL chkxer(
'ZHSEQR', infot, nout, lerr, ok )
339 CALL zhseqr(
'E',
'N', 2, 1, 2, a, 1, x, c, 2, w, 1, info )
340 CALL chkxer(
'ZHSEQR', infot, nout, lerr, ok )
342 CALL zhseqr(
'E',
'V', 2, 1, 2, a, 2, x, c, 1, w, 1, info )
343 CALL chkxer(
'ZHSEQR', infot, nout, lerr, ok )
350 CALL zhsein(
'/',
'N',
'N', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
351 $ m, w, rw, ifaill, ifailr, info )
352 CALL chkxer(
'ZHSEIN', infot, nout, lerr, ok )
354 CALL zhsein(
'R',
'/',
'N', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
355 $ m, w, rw, ifaill, ifailr, info )
356 CALL chkxer(
'ZHSEIN', infot, nout, lerr, ok )
358 CALL zhsein(
'R',
'N',
'/', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
359 $ m, w, rw, ifaill, ifailr, info )
360 CALL chkxer(
'ZHSEIN', infot, nout, lerr, ok )
362 CALL zhsein(
'R',
'N',
'N', sel, -1, a, 1, x, vl, 1, vr, 1, 0,
363 $ m, w, rw, ifaill, ifailr, info )
364 CALL chkxer(
'ZHSEIN', infot, nout, lerr, ok )
366 CALL zhsein(
'R',
'N',
'N', sel, 2, a, 1, x, vl, 1, vr, 2, 4,
367 $ m, w, rw, ifaill, ifailr, info )
368 CALL chkxer(
'ZHSEIN', infot, nout, lerr, ok )
370 CALL zhsein(
'L',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 1, 4,
371 $ m, w, rw, ifaill, ifailr, info )
372 CALL chkxer(
'ZHSEIN', infot, nout, lerr, ok )
374 CALL zhsein(
'R',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 1, 4,
375 $ m, w, rw, ifaill, ifailr, info )
376 CALL chkxer(
'ZHSEIN', infot, nout, lerr, ok )
378 CALL zhsein(
'R',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 2, 1,
379 $ m, w, rw, ifaill, ifailr, info )
380 CALL chkxer(
'ZHSEIN', infot, nout, lerr, ok )
387 CALL ztrevc(
'/',
'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w, rw,
389 CALL chkxer(
'ZTREVC', infot, nout, lerr, ok )
391 CALL ztrevc(
'L',
'/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w, rw,
393 CALL chkxer(
'ZTREVC', infot, nout, lerr, ok )
395 CALL ztrevc(
'L',
'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
397 CALL chkxer(
'ZTREVC', infot, nout, lerr, ok )
399 CALL ztrevc(
'L',
'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w, rw,
401 CALL chkxer(
'ZTREVC', infot, nout, lerr, ok )
403 CALL ztrevc(
'L',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w, rw,
405 CALL chkxer(
'ZTREVC', infot, nout, lerr, ok )
407 CALL ztrevc(
'R',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w, rw,
409 CALL chkxer(
'ZTREVC', infot, nout, lerr, ok )
411 CALL ztrevc(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w, rw,
413 CALL chkxer(
'ZTREVC', infot, nout, lerr, ok )
420 CALL ztrevc3(
'/',
'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
422 CALL chkxer(
'ZTREVC3', infot, nout, lerr, ok )
424 CALL ztrevc3(
'L',
'/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
426 CALL chkxer(
'ZTREVC3', infot, nout, lerr, ok )
428 CALL ztrevc3(
'L',
'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
430 CALL chkxer(
'ZTREVC3', infot, nout, lerr, ok )
432 CALL ztrevc3(
'L',
'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
434 CALL chkxer(
'ZTREVC3', infot, nout, lerr, ok )
436 CALL ztrevc3(
'L',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
438 CALL chkxer(
'ZTREVC3', infot, nout, lerr, ok )
440 CALL ztrevc3(
'R',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
442 CALL chkxer(
'ZTREVC3', infot, nout, lerr, ok )
444 CALL ztrevc3(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
446 CALL chkxer(
'ZTREVC3', infot, nout, lerr, ok )
448 CALL ztrevc3(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
450 CALL chkxer(
'ZTREVC3', infot, nout, lerr, ok )
452 CALL ztrevc3(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
454 CALL chkxer(
'ZTREVC3', infot, nout, lerr, ok )
461 WRITE( nout, fmt = 9999 )path, nt
463 WRITE( nout, fmt = 9998 )path
466 9999
FORMAT( 1x, a3,
' routines passed the tests of the error exits',
467 $
' (', i3,
' tests done)' )
468 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ',
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine zgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
ZGEBAK
subroutine zgebal(job, n, a, lda, ilo, ihi, scale, info)
ZGEBAL
subroutine zgehd2(n, ilo, ihi, a, lda, tau, work, info)
ZGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm.
subroutine zgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
ZGEHRD
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
subroutine ztrevc3(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, lwork, rwork, lrwork, info)
ZTREVC3
subroutine ztrevc(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, rwork, info)
ZTREVC
subroutine zunghr(n, ilo, ihi, a, lda, tau, work, lwork, info)
ZUNGHR
subroutine zunmhr(side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork, info)
ZUNMHR
subroutine zerrhs(path, nunit)
ZERRHS