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