LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ derrhs()

subroutine derrhs ( character*3  path,
integer  nunit 
)

DERRHS

Purpose:
 DERRHS tests the error exits for DGEBAK, DGEBAL, DGEHRD, DGEHD2,
 DORGHR, DORMHR, DHSEQR, DHSEIN, DTREVC, and DTREVC3.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 54 of file derrhs.f.

55*
56* -- LAPACK test routine --
57* -- LAPACK is a software package provided by Univ. of Tennessee, --
58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59*
60* .. Scalar Arguments ..
61 CHARACTER*3 PATH
62 INTEGER NUNIT
63* ..
64*
65* =====================================================================
66*
67* .. Parameters ..
68 INTEGER NMAX, LW
69 parameter( nmax = 3, lw = ( nmax+2 )*( nmax+2 )+nmax )
70* ..
71* .. Local Scalars ..
72 CHARACTER*2 C2
73 INTEGER I, IHI, ILO, INFO, J, M, NT
74* ..
75* .. Local Arrays ..
76 LOGICAL SEL( NMAX )
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 ),
81 $ WR( NMAX )
82* ..
83* .. External Functions ..
84 LOGICAL LSAMEN
85 EXTERNAL lsamen
86* ..
87* .. External Subroutines ..
88 EXTERNAL chkxer, dgebak, dgebal, dgehrd, dhsein, dhseqr,
90* ..
91* .. Intrinsic Functions ..
92 INTRINSIC dble
93* ..
94* .. Scalars in Common ..
95 LOGICAL LERR, OK
96 CHARACTER*32 SRNAMT
97 INTEGER INFOT, NOUT
98* ..
99* .. Common blocks ..
100 COMMON / infoc / infot, nout, ok, lerr
101 COMMON / srnamc / srnamt
102* ..
103* .. Executable Statements ..
104*
105 nout = nunit
106 WRITE( nout, fmt = * )
107 c2 = path( 2: 3 )
108*
109* Set the variables to innocuous values.
110*
111 DO 20 j = 1, nmax
112 DO 10 i = 1, nmax
113 a( i, j ) = 1.d0 / dble( i+j )
114 10 CONTINUE
115 wi( j ) = dble( j )
116 sel( j ) = .true.
117 20 CONTINUE
118 ok = .true.
119 nt = 0
120*
121* Test error exits of the nonsymmetric eigenvalue routines.
122*
123 IF( lsamen( 2, c2, 'HS' ) ) THEN
124*
125* DGEBAL
126*
127 srnamt = 'DGEBAL'
128 infot = 1
129 CALL dgebal( '/', 0, a, 1, ilo, ihi, s, info )
130 CALL chkxer( 'DGEBAL', infot, nout, lerr, ok )
131 infot = 2
132 CALL dgebal( 'N', -1, a, 1, ilo, ihi, s, info )
133 CALL chkxer( 'DGEBAL', infot, nout, lerr, ok )
134 infot = 4
135 CALL dgebal( 'N', 2, a, 1, ilo, ihi, s, info )
136 CALL chkxer( 'DGEBAL', infot, nout, lerr, ok )
137 nt = nt + 3
138*
139* DGEBAK
140*
141 srnamt = 'DGEBAK'
142 infot = 1
143 CALL dgebak( '/', 'R', 0, 1, 0, s, 0, a, 1, info )
144 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
145 infot = 2
146 CALL dgebak( 'N', '/', 0, 1, 0, s, 0, a, 1, info )
147 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
148 infot = 3
149 CALL dgebak( 'N', 'R', -1, 1, 0, s, 0, a, 1, info )
150 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
151 infot = 4
152 CALL dgebak( 'N', 'R', 0, 0, 0, s, 0, a, 1, info )
153 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
154 infot = 4
155 CALL dgebak( 'N', 'R', 0, 2, 0, s, 0, a, 1, info )
156 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
157 infot = 5
158 CALL dgebak( 'N', 'R', 2, 2, 1, s, 0, a, 2, info )
159 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
160 infot = 5
161 CALL dgebak( 'N', 'R', 0, 1, 1, s, 0, a, 1, info )
162 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
163 infot = 7
164 CALL dgebak( 'N', 'R', 0, 1, 0, s, -1, a, 1, info )
165 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
166 infot = 9
167 CALL dgebak( 'N', 'R', 2, 1, 2, s, 0, a, 1, info )
168 CALL chkxer( 'DGEBAK', infot, nout, lerr, ok )
169 nt = nt + 9
170*
171* DGEHRD
172*
173 srnamt = 'DGEHRD'
174 infot = 1
175 CALL dgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
176 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
177 infot = 2
178 CALL dgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
179 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
180 infot = 2
181 CALL dgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
182 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
183 infot = 3
184 CALL dgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
185 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
186 infot = 3
187 CALL dgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
188 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
189 infot = 5
190 CALL dgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
191 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
192 infot = 8
193 CALL dgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
194 CALL chkxer( 'DGEHRD', infot, nout, lerr, ok )
195 nt = nt + 7
196*
197* DGEHD2
198*
199 srnamt = 'DGEHD2'
200 infot = 1
201 CALL dgehd2( -1, 1, 1, a, 1, tau, w, info )
202 CALL chkxer( 'DGEHD2', infot, nout, lerr, ok )
203 infot = 2
204 CALL dgehd2( 0, 0, 0, a, 1, tau, w, info )
205 CALL chkxer( 'DGEHD2', infot, nout, lerr, ok )
206 infot = 2
207 CALL dgehd2( 0, 2, 0, a, 1, tau, w, info )
208 CALL chkxer( 'DGEHD2', infot, nout, lerr, ok )
209 infot = 3
210 CALL dgehd2( 1, 1, 0, a, 1, tau, w, info )
211 CALL chkxer( 'DGEHD2', infot, nout, lerr, ok )
212 infot = 3
213 CALL dgehd2( 0, 1, 1, a, 1, tau, w, info )
214 CALL chkxer( 'DGEHD2', infot, nout, lerr, ok )
215 infot = 5
216 CALL dgehd2( 2, 1, 1, a, 1, tau, w, info )
217 CALL chkxer( 'DGEHD2', infot, nout, lerr, ok )
218 nt = nt + 6
219*
220* DORGHR
221*
222 srnamt = 'DORGHR'
223 infot = 1
224 CALL dorghr( -1, 1, 1, a, 1, tau, w, 1, info )
225 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
226 infot = 2
227 CALL dorghr( 0, 0, 0, a, 1, tau, w, 1, info )
228 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
229 infot = 2
230 CALL dorghr( 0, 2, 0, a, 1, tau, w, 1, info )
231 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
232 infot = 3
233 CALL dorghr( 1, 1, 0, a, 1, tau, w, 1, info )
234 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
235 infot = 3
236 CALL dorghr( 0, 1, 1, a, 1, tau, w, 1, info )
237 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
238 infot = 5
239 CALL dorghr( 2, 1, 1, a, 1, tau, w, 1, info )
240 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
241 infot = 8
242 CALL dorghr( 3, 1, 3, a, 3, tau, w, 1, info )
243 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
244 nt = nt + 7
245*
246* DORMHR
247*
248 srnamt = 'DORMHR'
249 infot = 1
250 CALL dormhr( '/', 'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
251 $ info )
252 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
253 infot = 2
254 CALL dormhr( 'L', '/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
255 $ info )
256 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
257 infot = 3
258 CALL dormhr( 'L', 'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
259 $ info )
260 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
261 infot = 4
262 CALL dormhr( 'L', 'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
263 $ info )
264 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
265 infot = 5
266 CALL dormhr( 'L', 'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
267 $ info )
268 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
269 infot = 5
270 CALL dormhr( 'L', 'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
271 $ info )
272 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
273 infot = 5
274 CALL dormhr( 'L', 'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
275 $ info )
276 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
277 infot = 5
278 CALL dormhr( 'R', 'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
279 $ info )
280 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
281 infot = 6
282 CALL dormhr( 'L', 'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
283 $ info )
284 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
285 infot = 6
286 CALL dormhr( 'L', 'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
287 $ info )
288 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
289 infot = 6
290 CALL dormhr( 'R', 'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
291 $ info )
292 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
293 infot = 8
294 CALL dormhr( 'L', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
295 $ info )
296 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
297 infot = 8
298 CALL dormhr( 'R', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
299 $ info )
300 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
301 infot = 11
302 CALL dormhr( 'L', 'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
303 $ info )
304 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
305 infot = 13
306 CALL dormhr( 'L', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
307 $ info )
308 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
309 infot = 13
310 CALL dormhr( 'R', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
311 $ info )
312 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
313 nt = nt + 16
314*
315* DHSEQR
316*
317 srnamt = 'DHSEQR'
318 infot = 1
319 CALL dhseqr( '/', 'N', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
320 $ info )
321 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
322 infot = 2
323 CALL dhseqr( 'E', '/', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
324 $ info )
325 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
326 infot = 3
327 CALL dhseqr( 'E', 'N', -1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
328 $ info )
329 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
330 infot = 4
331 CALL dhseqr( 'E', 'N', 0, 0, 0, a, 1, wr, wi, c, 1, w, 1,
332 $ info )
333 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
334 infot = 4
335 CALL dhseqr( 'E', 'N', 0, 2, 0, a, 1, wr, wi, c, 1, w, 1,
336 $ info )
337 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
338 infot = 5
339 CALL dhseqr( 'E', 'N', 1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
340 $ info )
341 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
342 infot = 5
343 CALL dhseqr( 'E', 'N', 1, 1, 2, a, 1, wr, wi, c, 1, w, 1,
344 $ info )
345 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
346 infot = 7
347 CALL dhseqr( 'E', 'N', 2, 1, 2, a, 1, wr, wi, c, 2, w, 1,
348 $ info )
349 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
350 infot = 11
351 CALL dhseqr( 'E', 'V', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
352 $ info )
353 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
354 infot = 13
355 CALL dhseqr( 'E', 'N', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
356 $ info )
357 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
358 nt = nt + 10
359*
360* DHSEIN
361*
362 srnamt = 'DHSEIN'
363 infot = 1
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 )
367 infot = 2
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 )
371 infot = 3
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 )
375 infot = 5
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 )
379 infot = 7
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 )
383 infot = 11
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 )
387 infot = 13
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 )
391 infot = 14
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 )
395 nt = nt + 8
396*
397* DTREVC
398*
399 srnamt = 'DTREVC'
400 infot = 1
401 CALL dtrevc( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
402 $ info )
403 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
404 infot = 2
405 CALL dtrevc( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
406 $ info )
407 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
408 infot = 4
409 CALL dtrevc( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
410 $ info )
411 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
412 infot = 6
413 CALL dtrevc( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
414 $ info )
415 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
416 infot = 8
417 CALL dtrevc( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
418 $ info )
419 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
420 infot = 10
421 CALL dtrevc( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
422 $ info )
423 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
424 infot = 11
425 CALL dtrevc( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
426 $ info )
427 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
428 nt = nt + 7
429*
430* DTREVC3
431*
432 srnamt = 'DTREVC3'
433 infot = 1
434 CALL dtrevc3( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
435 $ lw, info )
436 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
437 infot = 2
438 CALL dtrevc3( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
439 $ lw, info )
440 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
441 infot = 4
442 CALL dtrevc3( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
443 $ lw, info )
444 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
445 infot = 6
446 CALL dtrevc3( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
447 $ lw, info )
448 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
449 infot = 8
450 CALL dtrevc3( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
451 $ lw, info )
452 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
453 infot = 10
454 CALL dtrevc3( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
455 $ lw, info )
456 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
457 infot = 11
458 CALL dtrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
459 $ lw, info )
460 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
461 infot = 14
462 CALL dtrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
463 $ 2, info )
464 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
465 nt = nt + 8
466 END IF
467*
468* Print a summary line.
469*
470 IF( ok ) THEN
471 WRITE( nout, fmt = 9999 )path, nt
472 ELSE
473 WRITE( nout, fmt = 9998 )path
474 END IF
475*
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 ',
479 $ 'exits ***' )
480*
481 RETURN
482*
483* End of DERRHS
484*
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
subroutine dgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
DGEBAK
Definition dgebak.f:130
subroutine dgebal(job, n, a, lda, ilo, ihi, scale, info)
DGEBAL
Definition dgebal.f:163
subroutine dgehd2(n, ilo, ihi, a, lda, tau, work, info)
DGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm.
Definition dgehd2.f:149
subroutine dgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
DGEHRD
Definition dgehrd.f:167
subroutine dhsein(side, eigsrc, initv, select, n, h, ldh, wr, wi, vl, ldvl, vr, ldvr, mm, m, work, ifaill, ifailr, info)
DHSEIN
Definition dhsein.f:263
subroutine dhseqr(job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork, info)
DHSEQR
Definition dhseqr.f:316
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
subroutine dtrevc3(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, lwork, info)
DTREVC3
Definition dtrevc3.f:237
subroutine dtrevc(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, info)
DTREVC
Definition dtrevc.f:222
subroutine dorghr(n, ilo, ihi, a, lda, tau, work, lwork, info)
DORGHR
Definition dorghr.f:126
subroutine dormhr(side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork, info)
DORMHR
Definition dormhr.f:178
Here is the call graph for this function:
Here is the caller graph for this function: