69 parameter( nmax = 3, lw = ( nmax+2 )*( nmax+2 )+nmax )
73 INTEGER I, IHI, ILO, INFO, J, M, NT
77 INTEGER IFAILL( NMAX ), IFAILR( NMAX )
78 DOUBLE PRECISION A( NMAX, NMAX ), C( NMAX, NMAX ), S( NMAX ),
79 $ TAU( NMAX ), VL( NMAX, NMAX ),
80 $ VR( NMAX, NMAX ), W( LW ), WI( NMAX ),
100 COMMON / infoc / infot, nout, ok, lerr
101 COMMON / srnamc / srnamt
106 WRITE( nout, fmt = * )
113 a( i, j ) = 1.d0 / dble( i+j )
123 IF( lsamen( 2, c2,
'HS' ) )
THEN
129 CALL dgebal(
'/', 0, a, 1, ilo, ihi, s, info )
130 CALL chkxer(
'DGEBAL', infot, nout, lerr, ok )
132 CALL dgebal(
'N', -1, a, 1, ilo, ihi, s, info )
133 CALL chkxer(
'DGEBAL', infot, nout, lerr, ok )
135 CALL dgebal(
'N', 2, a, 1, ilo, ihi, s, info )
136 CALL chkxer(
'DGEBAL', infot, nout, lerr, ok )
143 CALL dgebak(
'/',
'R', 0, 1, 0, s, 0, a, 1, info )
144 CALL chkxer(
'DGEBAK', infot, nout, lerr, ok )
146 CALL dgebak(
'N',
'/', 0, 1, 0, s, 0, a, 1, info )
147 CALL chkxer(
'DGEBAK', infot, nout, lerr, ok )
149 CALL dgebak(
'N',
'R', -1, 1, 0, s, 0, a, 1, info )
150 CALL chkxer(
'DGEBAK', infot, nout, lerr, ok )
152 CALL dgebak(
'N',
'R', 0, 0, 0, s, 0, a, 1, info )
153 CALL chkxer(
'DGEBAK', infot, nout, lerr, ok )
155 CALL dgebak(
'N',
'R', 0, 2, 0, s, 0, a, 1, info )
156 CALL chkxer(
'DGEBAK', infot, nout, lerr, ok )
158 CALL dgebak(
'N',
'R', 2, 2, 1, s, 0, a, 2, info )
159 CALL chkxer(
'DGEBAK', infot, nout, lerr, ok )
161 CALL dgebak(
'N',
'R', 0, 1, 1, s, 0, a, 1, info )
162 CALL chkxer(
'DGEBAK', infot, nout, lerr, ok )
164 CALL dgebak(
'N',
'R', 0, 1, 0, s, -1, a, 1, info )
165 CALL chkxer(
'DGEBAK', infot, nout, lerr, ok )
167 CALL dgebak(
'N',
'R', 2, 1, 2, s, 0, a, 1, info )
168 CALL chkxer(
'DGEBAK', infot, nout, lerr, ok )
175 CALL dgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
176 CALL chkxer(
'DGEHRD', infot, nout, lerr, ok )
178 CALL dgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
179 CALL chkxer(
'DGEHRD', infot, nout, lerr, ok )
181 CALL dgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
182 CALL chkxer(
'DGEHRD', infot, nout, lerr, ok )
184 CALL dgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
185 CALL chkxer(
'DGEHRD', infot, nout, lerr, ok )
187 CALL dgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
188 CALL chkxer(
'DGEHRD', infot, nout, lerr, ok )
190 CALL dgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
191 CALL chkxer(
'DGEHRD', infot, nout, lerr, ok )
193 CALL dgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
194 CALL chkxer(
'DGEHRD', infot, nout, lerr, ok )
201 CALL dgehd2( -1, 1, 1, a, 1, tau, w, info )
202 CALL chkxer(
'DGEHD2', infot, nout, lerr, ok )
204 CALL dgehd2( 0, 0, 0, a, 1, tau, w, info )
205 CALL chkxer(
'DGEHD2', infot, nout, lerr, ok )
207 CALL dgehd2( 0, 2, 0, a, 1, tau, w, info )
208 CALL chkxer(
'DGEHD2', infot, nout, lerr, ok )
210 CALL dgehd2( 1, 1, 0, a, 1, tau, w, info )
211 CALL chkxer(
'DGEHD2', infot, nout, lerr, ok )
213 CALL dgehd2( 0, 1, 1, a, 1, tau, w, info )
214 CALL chkxer(
'DGEHD2', infot, nout, lerr, ok )
216 CALL dgehd2( 2, 1, 1, a, 1, tau, w, info )
217 CALL chkxer(
'DGEHD2', infot, nout, lerr, ok )
224 CALL dorghr( -1, 1, 1, a, 1, tau, w, 1, info )
225 CALL chkxer(
'DORGHR', infot, nout, lerr, ok )
227 CALL dorghr( 0, 0, 0, a, 1, tau, w, 1, info )
228 CALL chkxer(
'DORGHR', infot, nout, lerr, ok )
230 CALL dorghr( 0, 2, 0, a, 1, tau, w, 1, info )
231 CALL chkxer(
'DORGHR', infot, nout, lerr, ok )
233 CALL dorghr( 1, 1, 0, a, 1, tau, w, 1, info )
234 CALL chkxer(
'DORGHR', infot, nout, lerr, ok )
236 CALL dorghr( 0, 1, 1, a, 1, tau, w, 1, info )
237 CALL chkxer(
'DORGHR', infot, nout, lerr, ok )
239 CALL dorghr( 2, 1, 1, a, 1, tau, w, 1, info )
240 CALL chkxer(
'DORGHR', infot, nout, lerr, ok )
242 CALL dorghr( 3, 1, 3, a, 3, tau, w, 1, info )
243 CALL chkxer(
'DORGHR', infot, nout, lerr, ok )
250 CALL dormhr(
'/',
'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
252 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
254 CALL dormhr(
'L',
'/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
256 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
258 CALL dormhr(
'L',
'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
260 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
262 CALL dormhr(
'L',
'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
264 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
266 CALL dormhr(
'L',
'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
268 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
270 CALL dormhr(
'L',
'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
272 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
274 CALL dormhr(
'L',
'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
276 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
278 CALL dormhr(
'R',
'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
280 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
282 CALL dormhr(
'L',
'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
284 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
286 CALL dormhr(
'L',
'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
288 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
290 CALL dormhr(
'R',
'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
292 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
294 CALL dormhr(
'L',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
296 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
298 CALL dormhr(
'R',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
300 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
302 CALL dormhr(
'L',
'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
304 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
306 CALL dormhr(
'L',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
308 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
310 CALL dormhr(
'R',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
312 CALL chkxer(
'DORMHR', infot, nout, lerr, ok )
319 CALL dhseqr(
'/',
'N', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
321 CALL chkxer(
'DHSEQR', infot, nout, lerr, ok )
323 CALL dhseqr(
'E',
'/', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
325 CALL chkxer(
'DHSEQR', infot, nout, lerr, ok )
327 CALL dhseqr(
'E',
'N', -1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
329 CALL chkxer(
'DHSEQR', infot, nout, lerr, ok )
331 CALL dhseqr(
'E',
'N', 0, 0, 0, a, 1, wr, wi, c, 1, w, 1,
333 CALL chkxer(
'DHSEQR', infot, nout, lerr, ok )
335 CALL dhseqr(
'E',
'N', 0, 2, 0, a, 1, wr, wi, c, 1, w, 1,
337 CALL chkxer(
'DHSEQR', infot, nout, lerr, ok )
339 CALL dhseqr(
'E',
'N', 1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
341 CALL chkxer(
'DHSEQR', infot, nout, lerr, ok )
343 CALL dhseqr(
'E',
'N', 1, 1, 2, a, 1, wr, wi, c, 1, w, 1,
345 CALL chkxer(
'DHSEQR', infot, nout, lerr, ok )
347 CALL dhseqr(
'E',
'N', 2, 1, 2, a, 1, wr, wi, c, 2, w, 1,
349 CALL chkxer(
'DHSEQR', infot, nout, lerr, ok )
351 CALL dhseqr(
'E',
'V', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
353 CALL chkxer(
'DHSEQR', infot, nout, lerr, ok )
355 CALL dhseqr(
'E',
'N', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
357 CALL chkxer(
'DHSEQR', infot, nout, lerr, ok )
364 CALL dhsein(
'/',
'N',
'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
365 $ 0, m, w, ifaill, ifailr, info )
366 CALL chkxer(
'DHSEIN', infot, nout, lerr, ok )
368 CALL dhsein(
'R',
'/',
'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
369 $ 0, m, w, ifaill, ifailr, info )
370 CALL chkxer(
'DHSEIN', infot, nout, lerr, ok )
372 CALL dhsein(
'R',
'N',
'/', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
373 $ 0, m, w, ifaill, ifailr, info )
374 CALL chkxer(
'DHSEIN', infot, nout, lerr, ok )
376 CALL dhsein(
'R',
'N',
'N', sel, -1, a, 1, wr, wi, vl, 1, vr,
377 $ 1, 0, m, w, ifaill, ifailr, info )
378 CALL chkxer(
'DHSEIN', infot, nout, lerr, ok )
380 CALL dhsein(
'R',
'N',
'N', sel, 2, a, 1, wr, wi, vl, 1, vr, 2,
381 $ 4, m, w, ifaill, ifailr, info )
382 CALL chkxer(
'DHSEIN', infot, nout, lerr, ok )
384 CALL dhsein(
'L',
'N',
'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
385 $ 4, m, w, ifaill, ifailr, info )
386 CALL chkxer(
'DHSEIN', infot, nout, lerr, ok )
388 CALL dhsein(
'R',
'N',
'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
389 $ 4, m, w, ifaill, ifailr, info )
390 CALL chkxer(
'DHSEIN', infot, nout, lerr, ok )
392 CALL dhsein(
'R',
'N',
'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 2,
393 $ 1, m, w, ifaill, ifailr, info )
394 CALL chkxer(
'DHSEIN', infot, nout, lerr, ok )
401 CALL dtrevc(
'/',
'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
403 CALL chkxer(
'DTREVC', infot, nout, lerr, ok )
405 CALL dtrevc(
'L',
'/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
407 CALL chkxer(
'DTREVC', infot, nout, lerr, ok )
409 CALL dtrevc(
'L',
'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
411 CALL chkxer(
'DTREVC', infot, nout, lerr, ok )
413 CALL dtrevc(
'L',
'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
415 CALL chkxer(
'DTREVC', infot, nout, lerr, ok )
417 CALL dtrevc(
'L',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
419 CALL chkxer(
'DTREVC', infot, nout, lerr, ok )
421 CALL dtrevc(
'R',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
423 CALL chkxer(
'DTREVC', infot, nout, lerr, ok )
425 CALL dtrevc(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
427 CALL chkxer(
'DTREVC', infot, nout, lerr, ok )
434 CALL dtrevc3(
'/',
'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
436 CALL chkxer(
'DTREVC3', infot, nout, lerr, ok )
438 CALL dtrevc3(
'L',
'/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
440 CALL chkxer(
'DTREVC3', infot, nout, lerr, ok )
442 CALL dtrevc3(
'L',
'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
444 CALL chkxer(
'DTREVC3', infot, nout, lerr, ok )
446 CALL dtrevc3(
'L',
'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
448 CALL chkxer(
'DTREVC3', infot, nout, lerr, ok )
450 CALL dtrevc3(
'L',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
452 CALL chkxer(
'DTREVC3', infot, nout, lerr, ok )
454 CALL dtrevc3(
'R',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
456 CALL chkxer(
'DTREVC3', infot, nout, lerr, ok )
458 CALL dtrevc3(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
460 CALL chkxer(
'DTREVC3', infot, nout, lerr, ok )
462 CALL dtrevc3(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
464 CALL chkxer(
'DTREVC3', infot, nout, lerr, ok )
471 WRITE( nout, fmt = 9999 )path, nt
473 WRITE( nout, fmt = 9998 )path
476 9999
FORMAT( 1x, a3,
' routines passed the tests of the error exits',
477 $
' (', i3,
' tests done)' )
478 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ',
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine derrhs(path, nunit)
DERRHS
subroutine dgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
DGEBAK
subroutine dgebal(job, n, a, lda, ilo, ihi, scale, info)
DGEBAL
subroutine dgehd2(n, ilo, ihi, a, lda, tau, work, info)
DGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm.
subroutine dgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
DGEHRD
subroutine dhsein(side, eigsrc, initv, select, n, h, ldh, wr, wi, vl, ldvl, vr, ldvr, mm, m, work, ifaill, ifailr, info)
DHSEIN
subroutine dhseqr(job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork, info)
DHSEQR
subroutine dtrevc3(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, lwork, info)
DTREVC3
subroutine dtrevc(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, info)
DTREVC
subroutine dorghr(n, ilo, ihi, a, lda, tau, work, lwork, info)
DORGHR
subroutine dormhr(side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork, info)
DORMHR