72 parameter ( nmax = 3, lw = nmax*nmax )
76 INTEGER i, ihi, ilo, info, j, m, nt
80 INTEGER ifaill( nmax ), ifailr( nmax )
81 REAL rw( nmax ), s( nmax )
82 COMPLEX 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. /
REAL( i+j )
125 IF(
lsamen( 2, c2,
'HS' ) )
THEN
131 CALL cgebal(
'/', 0, a, 1, ilo, ihi, s, info )
132 CALL chkxer(
'CGEBAL', infot, nout, lerr, ok )
134 CALL cgebal(
'N', -1, a, 1, ilo, ihi, s, info )
135 CALL chkxer(
'CGEBAL', infot, nout, lerr, ok )
137 CALL cgebal(
'N', 2, a, 1, ilo, ihi, s, info )
138 CALL chkxer(
'CGEBAL', infot, nout, lerr, ok )
145 CALL cgebak(
'/',
'R', 0, 1, 0, s, 0, a, 1, info )
146 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
148 CALL cgebak(
'N',
'/', 0, 1, 0, s, 0, a, 1, info )
149 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
151 CALL cgebak(
'N',
'R', -1, 1, 0, s, 0, a, 1, info )
152 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
154 CALL cgebak(
'N',
'R', 0, 0, 0, s, 0, a, 1, info )
155 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
157 CALL cgebak(
'N',
'R', 0, 2, 0, s, 0, a, 1, info )
158 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
160 CALL cgebak(
'N',
'R', 2, 2, 1, s, 0, a, 2, info )
161 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
163 CALL cgebak(
'N',
'R', 0, 1, 1, s, 0, a, 1, info )
164 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
166 CALL cgebak(
'N',
'R', 0, 1, 0, s, -1, a, 1, info )
167 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
169 CALL cgebak(
'N',
'R', 2, 1, 2, s, 0, a, 1, info )
170 CALL chkxer(
'CGEBAK', infot, nout, lerr, ok )
177 CALL cgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
178 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
180 CALL cgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
181 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
183 CALL cgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
184 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
186 CALL cgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
187 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
189 CALL cgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
190 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
192 CALL cgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
193 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
195 CALL cgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
196 CALL chkxer(
'CGEHRD', infot, nout, lerr, ok )
203 CALL cunghr( -1, 1, 1, a, 1, tau, w, 1, info )
204 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
206 CALL cunghr( 0, 0, 0, a, 1, tau, w, 1, info )
207 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
209 CALL cunghr( 0, 2, 0, a, 1, tau, w, 1, info )
210 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
212 CALL cunghr( 1, 1, 0, a, 1, tau, w, 1, info )
213 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
215 CALL cunghr( 0, 1, 1, a, 1, tau, w, 1, info )
216 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
218 CALL cunghr( 2, 1, 1, a, 1, tau, w, 1, info )
219 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
221 CALL cunghr( 3, 1, 3, a, 3, tau, w, 1, info )
222 CALL chkxer(
'CUNGHR', infot, nout, lerr, ok )
229 CALL cunmhr(
'/',
'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
231 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
233 CALL cunmhr(
'L',
'/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
235 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
237 CALL cunmhr(
'L',
'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
239 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
241 CALL cunmhr(
'L',
'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
243 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
245 CALL cunmhr(
'L',
'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
247 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
249 CALL cunmhr(
'L',
'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
251 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
253 CALL cunmhr(
'L',
'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
255 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
257 CALL cunmhr(
'R',
'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
259 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
261 CALL cunmhr(
'L',
'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
263 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
265 CALL cunmhr(
'L',
'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
267 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
269 CALL cunmhr(
'R',
'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
271 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
273 CALL cunmhr(
'L',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
275 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
277 CALL cunmhr(
'R',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
279 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
281 CALL cunmhr(
'L',
'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
283 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
285 CALL cunmhr(
'L',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
287 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
289 CALL cunmhr(
'R',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
291 CALL chkxer(
'CUNMHR', infot, nout, lerr, ok )
298 CALL chseqr(
'/',
'N', 0, 1, 0, a, 1, x, c, 1, w, 1,
300 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
302 CALL chseqr(
'E',
'/', 0, 1, 0, a, 1, x, c, 1, w, 1,
304 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
306 CALL chseqr(
'E',
'N', -1, 1, 0, a, 1, x, c, 1, w, 1,
308 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
310 CALL chseqr(
'E',
'N', 0, 0, 0, a, 1, x, c, 1, w, 1,
312 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
314 CALL chseqr(
'E',
'N', 0, 2, 0, a, 1, x, c, 1, w, 1,
316 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
318 CALL chseqr(
'E',
'N', 1, 1, 0, a, 1, x, c, 1, w, 1,
320 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
322 CALL chseqr(
'E',
'N', 1, 1, 2, a, 1, x, c, 1, w, 1,
324 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
326 CALL chseqr(
'E',
'N', 2, 1, 2, a, 1, x, c, 2, w, 1,
328 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
330 CALL chseqr(
'E',
'V', 2, 1, 2, a, 2, x, c, 1, w, 1,
332 CALL chkxer(
'CHSEQR', infot, nout, lerr, ok )
339 CALL chsein(
'/',
'N',
'N', sel, 0, a, 1, x, vl, 1, vr, 1,
340 $ 0, m, w, rw, ifaill, ifailr, info )
341 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
343 CALL chsein(
'R',
'/',
'N', sel, 0, a, 1, x, vl, 1, vr, 1,
344 $ 0, m, w, rw, ifaill, ifailr, info )
345 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
347 CALL chsein(
'R',
'N',
'/', sel, 0, a, 1, x, vl, 1, vr, 1,
348 $ 0, m, w, rw, ifaill, ifailr, info )
349 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
351 CALL chsein(
'R',
'N',
'N', sel, -1, a, 1, x, vl, 1, vr,
352 $ 1, 0, m, w, rw, ifaill, ifailr, info )
353 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
355 CALL chsein(
'R',
'N',
'N', sel, 2, a, 1, x, vl, 1, vr, 2,
356 $ 4, m, w, rw, ifaill, ifailr, info )
357 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
359 CALL chsein(
'L',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 1,
360 $ 4, m, w, rw, ifaill, ifailr, info )
361 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
363 CALL chsein(
'R',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 1,
364 $ 4, m, w, rw, ifaill, ifailr, info )
365 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
367 CALL chsein(
'R',
'N',
'N', sel, 2, a, 2, x, vl, 1, vr, 2,
368 $ 1, m, w, rw, ifaill, ifailr, info )
369 CALL chkxer(
'CHSEIN', infot, nout, lerr, ok )
376 CALL ctrevc(
'/',
'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
378 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
380 CALL ctrevc(
'L',
'/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
382 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
384 CALL ctrevc(
'L',
'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
386 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
388 CALL ctrevc(
'L',
'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
390 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
392 CALL ctrevc(
'L',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
394 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
396 CALL ctrevc(
'R',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
398 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
400 CALL ctrevc(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
402 CALL chkxer(
'CTREVC', infot, nout, lerr, ok )
409 WRITE( nout, fmt = 9999 )path, nt
411 WRITE( nout, fmt = 9998 )path
414 9999
FORMAT( 1x, a3,
' routines passed the tests of the error exits',
415 $
' (', i3,
' tests done)' )
416 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ',
subroutine chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR
subroutine ctrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
CTREVC
subroutine cgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
CGEBAK
subroutine chsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL, IFAILR, INFO)
CHSEIN
subroutine cunmhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMHR
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
logical function lsamen(N, CA, CB)
LSAMEN
subroutine cgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
CGEBAL
subroutine cgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CGEHRD
subroutine cunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CUNGHR