LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
derrhs.f
Go to the documentation of this file.
1*> \brief \b DERRHS
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE DERRHS( PATH, NUNIT )
12*
13* .. Scalar Arguments ..
14* CHARACTER*3 PATH
15* INTEGER NUNIT
16* ..
17*
18*
19*> \par Purpose:
20* =============
21*>
22*> \verbatim
23*>
24*> DERRHS tests the error exits for DGEBAK, DGEBAL, DGEHRD, DORGHR,
25*> DORMHR, DHSEQR, DHSEIN, DTREVC, and DTREVC3.
26*> \endverbatim
27*
28* Arguments:
29* ==========
30*
31*> \param[in] PATH
32*> \verbatim
33*> PATH is CHARACTER*3
34*> The LAPACK path name for the routines to be tested.
35*> \endverbatim
36*>
37*> \param[in] NUNIT
38*> \verbatim
39*> NUNIT is INTEGER
40*> The unit number for output.
41*> \endverbatim
42*
43* Authors:
44* ========
45*
46*> \author Univ. of Tennessee
47*> \author Univ. of California Berkeley
48*> \author Univ. of Colorado Denver
49*> \author NAG Ltd.
50*
51*> \ingroup double_eig
52*
53* =====================================================================
54 SUBROUTINE derrhs( PATH, NUNIT )
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* DORGHR
198*
199 srnamt = 'DORGHR'
200 infot = 1
201 CALL dorghr( -1, 1, 1, a, 1, tau, w, 1, info )
202 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
203 infot = 2
204 CALL dorghr( 0, 0, 0, a, 1, tau, w, 1, info )
205 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
206 infot = 2
207 CALL dorghr( 0, 2, 0, a, 1, tau, w, 1, info )
208 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
209 infot = 3
210 CALL dorghr( 1, 1, 0, a, 1, tau, w, 1, info )
211 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
212 infot = 3
213 CALL dorghr( 0, 1, 1, a, 1, tau, w, 1, info )
214 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
215 infot = 5
216 CALL dorghr( 2, 1, 1, a, 1, tau, w, 1, info )
217 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
218 infot = 8
219 CALL dorghr( 3, 1, 3, a, 3, tau, w, 1, info )
220 CALL chkxer( 'DORGHR', infot, nout, lerr, ok )
221 nt = nt + 7
222*
223* DORMHR
224*
225 srnamt = 'DORMHR'
226 infot = 1
227 CALL dormhr( '/', 'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
228 $ info )
229 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
230 infot = 2
231 CALL dormhr( 'L', '/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
232 $ info )
233 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
234 infot = 3
235 CALL dormhr( 'L', 'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
236 $ info )
237 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
238 infot = 4
239 CALL dormhr( 'L', 'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
240 $ info )
241 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
242 infot = 5
243 CALL dormhr( 'L', 'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
244 $ info )
245 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
246 infot = 5
247 CALL dormhr( 'L', 'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
248 $ info )
249 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
250 infot = 5
251 CALL dormhr( 'L', 'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
252 $ info )
253 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
254 infot = 5
255 CALL dormhr( 'R', 'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
256 $ info )
257 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
258 infot = 6
259 CALL dormhr( 'L', 'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
260 $ info )
261 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
262 infot = 6
263 CALL dormhr( 'L', 'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
264 $ info )
265 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
266 infot = 6
267 CALL dormhr( 'R', 'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
268 $ info )
269 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
270 infot = 8
271 CALL dormhr( 'L', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
272 $ info )
273 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
274 infot = 8
275 CALL dormhr( 'R', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
276 $ info )
277 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
278 infot = 11
279 CALL dormhr( 'L', 'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
280 $ info )
281 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
282 infot = 13
283 CALL dormhr( 'L', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
284 $ info )
285 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
286 infot = 13
287 CALL dormhr( 'R', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
288 $ info )
289 CALL chkxer( 'DORMHR', infot, nout, lerr, ok )
290 nt = nt + 16
291*
292* DHSEQR
293*
294 srnamt = 'DHSEQR'
295 infot = 1
296 CALL dhseqr( '/', 'N', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
297 $ info )
298 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
299 infot = 2
300 CALL dhseqr( 'E', '/', 0, 1, 0, a, 1, wr, wi, c, 1, w, 1,
301 $ info )
302 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
303 infot = 3
304 CALL dhseqr( 'E', 'N', -1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
305 $ info )
306 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
307 infot = 4
308 CALL dhseqr( 'E', 'N', 0, 0, 0, a, 1, wr, wi, c, 1, w, 1,
309 $ info )
310 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
311 infot = 4
312 CALL dhseqr( 'E', 'N', 0, 2, 0, a, 1, wr, wi, c, 1, w, 1,
313 $ info )
314 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
315 infot = 5
316 CALL dhseqr( 'E', 'N', 1, 1, 0, a, 1, wr, wi, c, 1, w, 1,
317 $ info )
318 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
319 infot = 5
320 CALL dhseqr( 'E', 'N', 1, 1, 2, a, 1, wr, wi, c, 1, w, 1,
321 $ info )
322 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
323 infot = 7
324 CALL dhseqr( 'E', 'N', 2, 1, 2, a, 1, wr, wi, c, 2, w, 1,
325 $ info )
326 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
327 infot = 11
328 CALL dhseqr( 'E', 'V', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
329 $ info )
330 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
331 infot = 13
332 CALL dhseqr( 'E', 'N', 2, 1, 2, a, 2, wr, wi, c, 1, w, 1,
333 $ info )
334 CALL chkxer( 'DHSEQR', infot, nout, lerr, ok )
335 nt = nt + 10
336*
337* DHSEIN
338*
339 srnamt = 'DHSEIN'
340 infot = 1
341 CALL dhsein( '/', 'N', 'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
342 $ 0, m, w, ifaill, ifailr, info )
343 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
344 infot = 2
345 CALL dhsein( 'R', '/', 'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
346 $ 0, m, w, ifaill, ifailr, info )
347 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
348 infot = 3
349 CALL dhsein( 'R', 'N', '/', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
350 $ 0, m, w, ifaill, ifailr, info )
351 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
352 infot = 5
353 CALL dhsein( 'R', 'N', 'N', sel, -1, a, 1, wr, wi, vl, 1, vr,
354 $ 1, 0, m, w, ifaill, ifailr, info )
355 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
356 infot = 7
357 CALL dhsein( 'R', 'N', 'N', sel, 2, a, 1, wr, wi, vl, 1, vr, 2,
358 $ 4, m, w, ifaill, ifailr, info )
359 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
360 infot = 11
361 CALL dhsein( 'L', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
362 $ 4, m, w, ifaill, ifailr, info )
363 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
364 infot = 13
365 CALL dhsein( 'R', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
366 $ 4, m, w, ifaill, ifailr, info )
367 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
368 infot = 14
369 CALL dhsein( 'R', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 2,
370 $ 1, m, w, ifaill, ifailr, info )
371 CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
372 nt = nt + 8
373*
374* DTREVC
375*
376 srnamt = 'DTREVC'
377 infot = 1
378 CALL dtrevc( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
379 $ info )
380 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
381 infot = 2
382 CALL dtrevc( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
383 $ info )
384 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
385 infot = 4
386 CALL dtrevc( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
387 $ info )
388 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
389 infot = 6
390 CALL dtrevc( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
391 $ info )
392 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
393 infot = 8
394 CALL dtrevc( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
395 $ info )
396 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
397 infot = 10
398 CALL dtrevc( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
399 $ info )
400 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
401 infot = 11
402 CALL dtrevc( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
403 $ info )
404 CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
405 nt = nt + 7
406*
407* DTREVC3
408*
409 srnamt = 'DTREVC3'
410 infot = 1
411 CALL dtrevc3( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
412 $ lw, info )
413 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
414 infot = 2
415 CALL dtrevc3( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
416 $ lw, info )
417 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
418 infot = 4
419 CALL dtrevc3( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
420 $ lw, info )
421 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
422 infot = 6
423 CALL dtrevc3( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
424 $ lw, info )
425 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
426 infot = 8
427 CALL dtrevc3( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
428 $ lw, info )
429 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
430 infot = 10
431 CALL dtrevc3( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
432 $ lw, info )
433 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
434 infot = 11
435 CALL dtrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
436 $ lw, info )
437 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
438 infot = 14
439 CALL dtrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
440 $ 2, info )
441 CALL chkxer( 'DTREVC3', infot, nout, lerr, ok )
442 nt = nt + 8
443 END IF
444*
445* Print a summary line.
446*
447 IF( ok ) THEN
448 WRITE( nout, fmt = 9999 )path, nt
449 ELSE
450 WRITE( nout, fmt = 9998 )path
451 END IF
452*
453 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits',
454 $ ' (', i3, ' tests done)' )
455 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
456 $ 'exits ***' )
457*
458 RETURN
459*
460* End of DERRHS
461*
462 END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3224
subroutine derrhs(PATH, NUNIT)
DERRHS
Definition: derrhs.f:55
subroutine dgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DGEHRD
Definition: dgehrd.f:167
subroutine dgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
DGEBAL
Definition: dgebal.f:160
subroutine dgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
DGEBAK
Definition: dgebak.f:130
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 dtrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
DTREVC
Definition: dtrevc.f:222
subroutine dhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
DHSEQR
Definition: dhseqr.f:316
subroutine dormhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMHR
Definition: dormhr.f:178
subroutine dorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DORGHR
Definition: dorghr.f:126
subroutine dtrevc3(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, LWORK, INFO)
DTREVC3
Definition: dtrevc3.f:237