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 ',