LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
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, SGEBAL, SGEHRD, DORGHR,
25 *> DORMHR, DHSEQR, SHSEIN, and DTREVC.
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,
89  $ dorghr, dormhr, dtrevc
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  nt = nt + 9
332 *
333 * DHSEIN
334 *
335  srnamt = 'DHSEIN'
336  infot = 1
337  CALL dhsein( '/', 'N', 'N', sel, 0, a, 1, wr, wi, vl, 1, vr, 1,
338  $ 0, m, w, ifaill, ifailr, info )
339  CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
340  infot = 2
341  CALL dhsein( 'R', '/', '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 = 3
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 = 5
349  CALL dhsein( 'R', 'N', 'N', sel, -1, a, 1, wr, wi, vl, 1, vr,
350  $ 1, 0, m, w, ifaill, ifailr, info )
351  CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
352  infot = 7
353  CALL dhsein( 'R', 'N', 'N', sel, 2, a, 1, wr, wi, vl, 1, vr, 2,
354  $ 4, m, w, ifaill, ifailr, info )
355  CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
356  infot = 11
357  CALL dhsein( 'L', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 1,
358  $ 4, m, w, ifaill, ifailr, info )
359  CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
360  infot = 13
361  CALL dhsein( 'R', '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 = 14
365  CALL dhsein( 'R', 'N', 'N', sel, 2, a, 2, wr, wi, vl, 1, vr, 2,
366  $ 1, m, w, ifaill, ifailr, info )
367  CALL chkxer( 'DHSEIN', infot, nout, lerr, ok )
368  nt = nt + 8
369 *
370 * DTREVC
371 *
372  srnamt = 'DTREVC'
373  infot = 1
374  CALL dtrevc( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
375  $ info )
376  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
377  infot = 2
378  CALL dtrevc( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
379  $ info )
380  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
381  infot = 4
382  CALL dtrevc( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
383  $ info )
384  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
385  infot = 6
386  CALL dtrevc( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
387  $ info )
388  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
389  infot = 8
390  CALL dtrevc( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
391  $ info )
392  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
393  infot = 10
394  CALL dtrevc( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
395  $ info )
396  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
397  infot = 11
398  CALL dtrevc( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
399  $ info )
400  CALL chkxer( 'DTREVC', infot, nout, lerr, ok )
401  nt = nt + 7
402  END IF
403 *
404 * Print a summary line.
405 *
406  IF( ok ) THEN
407  WRITE( nout, fmt = 9999 )path, nt
408  ELSE
409  WRITE( nout, fmt = 9998 )path
410  END IF
411 *
412  9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits',
413  $ ' (', i3, ' tests done)' )
414  9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
415  $ 'exits ***' )
416 *
417  RETURN
418 *
419 * End of DERRHS
420 *
421  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
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