69 parameter( nmax = 3, lw = nmax*nmax )
73 INTEGER I, IHI, ILO, INFO, J, M, NT
77 INTEGER IFAILL( NMAX ), IFAILR( NMAX )
78 REAL RW( NMAX ), S( NMAX )
79 COMPLEX 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. / real( i+j )
122 IF( lsamen( 2, c2,
'HS' ) )
THEN
128 CALL cgebal(
'/', 0, a, 1, ilo, ihi, s, info )
129 CALL chkxer(
'CGEBAL', infot, nout, lerr, ok )
131 CALL cgebal(
'N', -1, a, 1, ilo, ihi, s, info )
132 CALL chkxer(
'CGEBAL', infot, nout, lerr, ok )
134 CALL cgebal(
'N', 2, a, 1, ilo, ihi, s, info )
135 CALL chkxer(
'CGEBAL', infot, nout, lerr, ok )
142 CALL cgebak(
'/',
'R', 0, 1, 0, s, 0, a, 1, info )
143 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
145 CALL cgebak(
'N',
'/', 0, 1, 0, s, 0, a, 1, info )
146 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
148 CALL cgebak(
'N',
'R', -1, 1, 0, s, 0, a, 1, info )
149 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
151 CALL cgebak(
'N',
'R', 0, 0, 0, s, 0, a, 1, info )
152 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
154 CALL cgebak(
'N',
'R', 0, 2, 0, s, 0, a, 1, info )
155 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
157 CALL cgebak(
'N',
'R', 2, 2, 1, s, 0, a, 2, info )
158 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
160 CALL cgebak(
'N',
'R', 0, 1, 1, s, 0, a, 1, info )
161 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
163 CALL cgebak(
'N',
'R', 0, 1, 0, s, -1, a, 1, info )
164 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
166 CALL cgebak(
'N',
'R', 2, 1, 2, s, 0, a, 1, info )
167 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
174 CALL cgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
175 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
177 CALL cgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
178 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
180 CALL cgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
181 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
183 CALL cgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
184 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
186 CALL cgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
187 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
189 CALL cgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
190 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
192 CALL cgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
193 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
200 CALL cgehd2( -1, 1, 1, a, 1, tau, w, info )
201 CALL chkxer(
'CGEHD2', infot, nout, lerr, ok )
203 CALL cgehd2( 0, 0, 0, a, 1, tau, w, info )
204 CALL chkxer(
'CGEHD2', infot, nout, lerr, ok )
206 CALL cgehd2( 0, 2, 0, a, 1, tau, w, info )
207 CALL chkxer(
'CGEHD2', infot, nout, lerr, ok )
209 CALL cgehd2( 1, 1, 0, a, 1, tau, w, info )
210 CALL chkxer(
'CGEHD2', infot, nout, lerr, ok )
212 CALL cgehd2( 0, 1, 1, a, 1, tau, w, info )
213 CALL chkxer(
'CGEHD2', infot, nout, lerr, ok )
215 CALL cgehd2( 2, 1, 1, a, 1, tau, w, info )
216 CALL chkxer(
'CGEHD2', infot, nout, lerr, ok )
223 CALL cunghr( -1, 1, 1, a, 1, tau, w, 1, info )
224 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
226 CALL cunghr( 0, 0, 0, a, 1, tau, w, 1, info )
227 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
229 CALL cunghr( 0, 2, 0, a, 1, tau, w, 1, info )
230 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
232 CALL cunghr( 1, 1, 0, a, 1, tau, w, 1, info )
233 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
235 CALL cunghr( 0, 1, 1, a, 1, tau, w, 1, info )
236 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
238 CALL cunghr( 2, 1, 1, a, 1, tau, w, 1, info )
239 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
241 CALL cunghr( 3, 1, 3, a, 3, tau, w, 1, info )
242 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
249 CALL cunmhr(
'/',
'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
251 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
253 CALL cunmhr(
'L',
'/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
255 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
257 CALL cunmhr(
'L',
'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
259 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
261 CALL cunmhr(
'L',
'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
263 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
265 CALL cunmhr(
'L',
'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
267 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
269 CALL cunmhr(
'L',
'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
271 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
273 CALL cunmhr(
'L',
'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
275 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
277 CALL cunmhr(
'R',
'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
279 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
281 CALL cunmhr(
'L',
'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
283 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
285 CALL cunmhr(
'L',
'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
287 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
289 CALL cunmhr(
'R',
'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
291 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
293 CALL cunmhr(
'L',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
295 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
297 CALL cunmhr(
'R',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
299 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
301 CALL cunmhr(
'L',
'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
303 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
305 CALL cunmhr(
'L',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
307 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
309 CALL cunmhr(
'R',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
311 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
318 CALL chseqr(
'/',
'N', 0, 1, 0, a, 1, x, c, 1, w, 1,
320 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
322 CALL chseqr(
'E',
'/', 0, 1, 0, a, 1, x, c, 1, w, 1,
324 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
326 CALL chseqr(
'E',
'N', -1, 1, 0, a, 1, x, c, 1, w, 1,
328 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
330 CALL chseqr(
'E',
'N', 0, 0, 0, a, 1, x, c, 1, w, 1,
332 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
334 CALL chseqr(
'E',
'N', 0, 2, 0, a, 1, x, c, 1, w, 1,
336 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
338 CALL chseqr(
'E',
'N', 1, 1, 0, a, 1, x, c, 1, w, 1,
340 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
342 CALL chseqr(
'E',
'N', 1, 1, 2, a, 1, x, c, 1, w, 1,
344 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
346 CALL chseqr(
'E',
'N', 2, 1, 2, a, 1, x, c, 2, w, 1,
348 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
350 CALL chseqr(
'E',
'V', 2, 1, 2, a, 2, x, c, 1, w, 1,
352 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
359 CALL chsein(
'/',
'N',
'N', sel, 0, a, 1, x, vl, 1, vr, 1,
360 $ 0, m, w, rw, ifaill, ifailr, info )
361 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
363 CALL chsein(
'R',
'/',
'N', sel, 0, a, 1, x, vl, 1, vr, 1,
364 $ 0, m, w, rw, ifaill, ifailr, info )
365 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
367 CALL chsein(
'R',
'N',
'/', sel, 0, a, 1, x, vl, 1, vr, 1,
368 $ 0, m, w, rw, ifaill, ifailr, info )
369 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
371 CALL chsein(
'R',
'N',
'N', sel, -1, a, 1, x, vl, 1, vr,
372 $ 1, 0, m, w, rw, ifaill, ifailr, info )
373 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
375 CALL chsein(
'R',
'N',
'N', sel, 2, a, 1, x, vl, 1, vr, 2,
376 $ 4, m, w, rw, ifaill, ifailr, info )
377 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
379 CALL chsein(
'L',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 1,
380 $ 4, m, w, rw, ifaill, ifailr, info )
381 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
383 CALL chsein(
'R',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 1,
384 $ 4, m, w, rw, ifaill, ifailr, info )
385 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
387 CALL chsein(
'R',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 2,
388 $ 1, m, w, rw, ifaill, ifailr, info )
389 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
396 CALL ctrevc(
'/',
'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
398 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
400 CALL ctrevc(
'L',
'/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
402 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
404 CALL ctrevc(
'L',
'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
406 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
408 CALL ctrevc(
'L',
'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
410 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
412 CALL ctrevc(
'L',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
414 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
416 CALL ctrevc(
'R',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
418 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
420 CALL ctrevc(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
422 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
429 CALL ctrevc3(
'/',
'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
431 CALL chkxer(
'CTREVC3', infot, nout, lerr, ok )
433 CALL ctrevc3(
'L',
'/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
435 CALL chkxer(
'CTREVC3', infot, nout, lerr, ok )
437 CALL ctrevc3(
'L',
'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
439 CALL chkxer(
'CTREVC3', infot, nout, lerr, ok )
441 CALL ctrevc3(
'L',
'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
443 CALL chkxer(
'CTREVC3', infot, nout, lerr, ok )
445 CALL ctrevc3(
'L',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
447 CALL chkxer(
'CTREVC3', infot, nout, lerr, ok )
449 CALL ctrevc3(
'R',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
451 CALL chkxer(
'CTREVC3', infot, nout, lerr, ok )
453 CALL ctrevc3(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
455 CALL chkxer(
'CTREVC3', infot, nout, lerr, ok )
457 CALL ctrevc3(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
459 CALL chkxer(
'CTREVC3', infot, nout, lerr, ok )
461 CALL ctrevc3(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
463 CALL chkxer(
'CTREVC3', infot, nout, lerr, ok )
470 WRITE( nout, fmt = 9999 )path, nt
472 WRITE( nout, fmt = 9998 )path
475 9999
FORMAT( 1x, a3,
' routines passed the tests of the error exits',
476 $
' (', i3,
' tests done)' )
477 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ',