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 ',