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 ',
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine cerrhs(path, nunit)
CERRHS
subroutine cgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
CGEBAK
subroutine cgebal(job, n, a, lda, ilo, ihi, scale, info)
CGEBAL
subroutine cgehd2(n, ilo, ihi, a, lda, tau, work, info)
CGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm.
subroutine cgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
CGEHRD
subroutine chsein(side, eigsrc, initv, select, n, h, ldh, w, vl, ldvl, vr, ldvr, mm, m, work, rwork, ifaill, ifailr, info)
CHSEIN
subroutine chseqr(job, compz, n, ilo, ihi, h, ldh, w, z, ldz, work, lwork, info)
CHSEQR
subroutine ctrevc3(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, lwork, rwork, lrwork, info)
CTREVC3
subroutine ctrevc(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, rwork, info)
CTREVC
subroutine cunghr(n, ilo, ihi, a, lda, tau, work, lwork, info)
CUNGHR
subroutine cunmhr(side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork, info)
CUNMHR