72 parameter( nmax = 3, lw = ( nmax+2 )*( nmax+2 )+nmax )
76 INTEGER I, IHI, ILO, INFO, J, M, NT
80 INTEGER IFAILL( nmax ), IFAILR( nmax )
81 DOUBLE PRECISION A( nmax, nmax ), C( nmax, nmax ), S( nmax ),
82 $ tau( nmax ), vl( nmax, nmax ),
83 $ vr( nmax, nmax ), w( lw ), wi( nmax ),
103 COMMON / infoc / infot, nout, ok, lerr
104 COMMON / srnamc / srnamt
109 WRITE( nout, fmt = * )
116 a( i, j ) = 1.d0 / dble( i+j )
126 IF( lsamen( 2, c2,
'HS' ) )
THEN
132 CALL
dgebal(
'/', 0, a, 1, ilo, ihi, s, info )
133 CALL
chkxer(
'DGEBAL', infot, nout, lerr, ok )
135 CALL
dgebal(
'N', -1, a, 1, ilo, ihi, s, info )
136 CALL
chkxer(
'DGEBAL', infot, nout, lerr, ok )
138 CALL
dgebal(
'N', 2, a, 1, ilo, ihi, s, info )
139 CALL
chkxer(
'DGEBAL', infot, nout, lerr, ok )
146 CALL
dgebak(
'/',
'R', 0, 1, 0, s, 0, a, 1, info )
147 CALL
chkxer(
'DGEBAK', infot, nout, lerr, ok )
149 CALL
dgebak(
'N',
'/', 0, 1, 0, s, 0, a, 1, info )
150 CALL
chkxer(
'DGEBAK', infot, nout, lerr, ok )
152 CALL
dgebak(
'N',
'R', -1, 1, 0, s, 0, a, 1, info )
153 CALL
chkxer(
'DGEBAK', infot, nout, lerr, ok )
155 CALL
dgebak(
'N',
'R', 0, 0, 0, s, 0, a, 1, info )
156 CALL
chkxer(
'DGEBAK', infot, nout, lerr, ok )
158 CALL
dgebak(
'N',
'R', 0, 2, 0, s, 0, a, 1, info )
159 CALL
chkxer(
'DGEBAK', infot, nout, lerr, ok )
161 CALL
dgebak(
'N',
'R', 2, 2, 1, s, 0, a, 2, info )
162 CALL
chkxer(
'DGEBAK', infot, nout, lerr, ok )
164 CALL
dgebak(
'N',
'R', 0, 1, 1, s, 0, a, 1, info )
165 CALL
chkxer(
'DGEBAK', infot, nout, lerr, ok )
167 CALL
dgebak(
'N',
'R', 0, 1, 0, s, -1, a, 1, info )
168 CALL
chkxer(
'DGEBAK', infot, nout, lerr, ok )
170 CALL
dgebak(
'N',
'R', 2, 1, 2, s, 0, a, 1, info )
171 CALL
chkxer(
'DGEBAK', infot, nout, lerr, ok )
178 CALL
dgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
179 CALL
chkxer(
'DGEHRD', infot, nout, lerr, ok )
181 CALL
dgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
182 CALL
chkxer(
'DGEHRD', infot, nout, lerr, ok )
184 CALL
dgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
185 CALL
chkxer(
'DGEHRD', infot, nout, lerr, ok )
187 CALL
dgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
188 CALL
chkxer(
'DGEHRD', infot, nout, lerr, ok )
190 CALL
dgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
191 CALL
chkxer(
'DGEHRD', infot, nout, lerr, ok )
193 CALL
dgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
194 CALL
chkxer(
'DGEHRD', infot, nout, lerr, ok )
196 CALL
dgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
197 CALL
chkxer(
'DGEHRD', infot, nout, lerr, ok )
204 CALL
dorghr( -1, 1, 1, a, 1, tau, w, 1, info )
205 CALL
chkxer(
'DORGHR', infot, nout, lerr, ok )
207 CALL
dorghr( 0, 0, 0, a, 1, tau, w, 1, info )
208 CALL
chkxer(
'DORGHR', infot, nout, lerr, ok )
210 CALL
dorghr( 0, 2, 0, a, 1, tau, w, 1, info )
211 CALL
chkxer(
'DORGHR', infot, nout, lerr, ok )
213 CALL
dorghr( 1, 1, 0, a, 1, tau, w, 1, info )
214 CALL
chkxer(
'DORGHR', infot, nout, lerr, ok )
216 CALL
dorghr( 0, 1, 1, a, 1, tau, w, 1, info )
217 CALL
chkxer(
'DORGHR', infot, nout, lerr, ok )
219 CALL
dorghr( 2, 1, 1, a, 1, tau, w, 1, info )
220 CALL
chkxer(
'DORGHR', infot, nout, lerr, ok )
222 CALL
dorghr( 3, 1, 3, a, 3, tau, w, 1, info )
223 CALL
chkxer(
'DORGHR', infot, nout, lerr, ok )
230 CALL
dormhr(
'/',
'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
232 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
234 CALL
dormhr(
'L',
'/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
236 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
238 CALL
dormhr(
'L',
'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
240 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
242 CALL
dormhr(
'L',
'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
244 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
246 CALL
dormhr(
'L',
'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
248 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
250 CALL
dormhr(
'L',
'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
252 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
254 CALL
dormhr(
'L',
'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
256 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
258 CALL
dormhr(
'R',
'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
260 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
262 CALL
dormhr(
'L',
'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
264 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
266 CALL
dormhr(
'L',
'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
268 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
270 CALL
dormhr(
'R',
'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
272 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
274 CALL
dormhr(
'L',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
276 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
278 CALL
dormhr(
'R',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
280 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
282 CALL
dormhr(
'L',
'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
284 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
286 CALL
dormhr(
'L',
'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
288 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
290 CALL
dormhr(
'R',
'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
292 CALL
chkxer(
'DORMHR', infot, nout, lerr, ok )
299 CALL
dhseqr(
'/',
'N', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
301 CALL
chkxer(
'DHSEQR', infot, nout, lerr, ok )
303 CALL
dhseqr(
'E',
'/', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
305 CALL
chkxer(
'DHSEQR', infot, nout, lerr, ok )
307 CALL
dhseqr(
'E',
'N', -1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
309 CALL
chkxer(
'DHSEQR', infot, nout, lerr, ok )
311 CALL
dhseqr(
'E',
'N', 0, 0, 0, a, 1, wr, wi, c, 1, w, 1,
313 CALL
chkxer(
'DHSEQR', infot, nout, lerr, ok )
315 CALL
dhseqr(
'E',
'N', 0, 2, 0, a, 1, wr, wi, c, 1, w, 1,
317 CALL
chkxer(
'DHSEQR', infot, nout, lerr, ok )
319 CALL
dhseqr(
'E',
'N', 1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
321 CALL
chkxer(
'DHSEQR', infot, nout, lerr, ok )
323 CALL
dhseqr(
'E',
'N', 1, 1, 2, a, 1, wr, wi, c, 1, w, 1,
325 CALL
chkxer(
'DHSEQR', infot, nout, lerr, ok )
327 CALL
dhseqr(
'E',
'N', 2, 1, 2, a, 1, wr, wi, c, 2, w, 1,
329 CALL
chkxer(
'DHSEQR', infot, nout, lerr, ok )
331 CALL
dhseqr(
'E',
'V', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
333 CALL
chkxer(
'DHSEQR', infot, nout, lerr, ok )
340 CALL
dhsein(
'/',
'N',
'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
341 $ 0, m, w, ifaill, ifailr, info )
342 CALL
chkxer(
'DHSEIN', infot, nout, lerr, ok )
344 CALL
dhsein(
'R',
'/',
'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
345 $ 0, m, w, ifaill, ifailr, info )
346 CALL
chkxer(
'DHSEIN', infot, nout, lerr, ok )
348 CALL
dhsein(
'R',
'N',
'/', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
349 $ 0, m, w, ifaill, ifailr, info )
350 CALL
chkxer(
'DHSEIN', infot, nout, lerr, ok )
352 CALL
dhsein(
'R',
'N',
'N', sel, -1, a, 1, wr, wi, vl, 1, vr,
353 $ 1, 0, m, w, ifaill, ifailr, info )
354 CALL
chkxer(
'DHSEIN', infot, nout, lerr, ok )
356 CALL
dhsein(
'R',
'N',
'N', sel, 2, a, 1, wr, wi, vl, 1, vr, 2,
357 $ 4, m, w, ifaill, ifailr, info )
358 CALL
chkxer(
'DHSEIN', infot, nout, lerr, ok )
360 CALL
dhsein(
'L',
'N',
'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
361 $ 4, m, w, ifaill, ifailr, info )
362 CALL
chkxer(
'DHSEIN', infot, nout, lerr, ok )
364 CALL
dhsein(
'R',
'N',
'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
365 $ 4, m, w, ifaill, ifailr, info )
366 CALL
chkxer(
'DHSEIN', infot, nout, lerr, ok )
368 CALL
dhsein(
'R',
'N',
'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 2,
369 $ 1, m, w, ifaill, ifailr, info )
370 CALL
chkxer(
'DHSEIN', infot, nout, lerr, ok )
377 CALL
dtrevc(
'/',
'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
379 CALL
chkxer(
'DTREVC', infot, nout, lerr, ok )
381 CALL
dtrevc(
'L',
'/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
383 CALL
chkxer(
'DTREVC', infot, nout, lerr, ok )
385 CALL
dtrevc(
'L',
'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
387 CALL
chkxer(
'DTREVC', infot, nout, lerr, ok )
389 CALL
dtrevc(
'L',
'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
391 CALL
chkxer(
'DTREVC', infot, nout, lerr, ok )
393 CALL
dtrevc(
'L',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
395 CALL
chkxer(
'DTREVC', infot, nout, lerr, ok )
397 CALL
dtrevc(
'R',
'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
399 CALL
chkxer(
'DTREVC', infot, nout, lerr, ok )
401 CALL
dtrevc(
'L',
'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
403 CALL
chkxer(
'DTREVC', infot, nout, lerr, ok )
410 WRITE( nout, fmt = 9999 )path, nt
412 WRITE( nout, fmt = 9998 )path
415 9999
FORMAT( 1x, a3,
' routines passed the tests of the error exits',
416 $
' (', i3,
' tests done)' )
417 9998
FORMAT(
' *** ', a3,
' routines failed the tests of the error ',
subroutine dgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DGEHRD
subroutine dhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
DHSEQR
subroutine dtrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
DTREVC
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine dgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
DGEBAL
subroutine dhsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI, VL, LDVL, VR, LDVR, MM, M, WORK, IFAILL, IFAILR, INFO)
DHSEIN
subroutine derrhs(PATH, NUNIT)
DERRHS
subroutine dormhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMHR
subroutine dgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
DGEBAK
subroutine dorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DORGHR