LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
cerrhs.f
Go to the documentation of this file.
1 *> \brief \b CERRHS
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 CERRHS( 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 *> CERRHS tests the error exits for CGEBAK, CGEBAL, CGEHRD, CUNGHR,
25 *> CUNMHR, CHSEQR, CHSEIN, and CTREVC.
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 complex_eig
52 *
53 * =====================================================================
54  SUBROUTINE cerrhs( 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*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  REAL RW( NMAX ), S( NMAX )
79  COMPLEX A( NMAX, NMAX ), C( NMAX, NMAX ), TAU( NMAX ),
80  $ VL( NMAX, NMAX ), VR( NMAX, NMAX ), W( LW ),
81  $ X( NMAX )
82 * ..
83 * .. External Functions ..
84  LOGICAL LSAMEN
85  EXTERNAL lsamen
86 * ..
87 * .. External Subroutines ..
88  EXTERNAL chkxer, cgebak, cgebal, cgehrd, chsein, chseqr,
89  $ cunghr, cunmhr, ctrevc
90 * ..
91 * .. Intrinsic Functions ..
92  INTRINSIC real
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. / real( i+j )
114  10 CONTINUE
115  sel( j ) = .true.
116  20 CONTINUE
117  ok = .true.
118  nt = 0
119 *
120 * Test error exits of the nonsymmetric eigenvalue routines.
121 *
122  IF( lsamen( 2, c2, 'HS' ) ) THEN
123 *
124 * CGEBAL
125 *
126  srnamt = 'CGEBAL'
127  infot = 1
128  CALL cgebal( '/', 0, a, 1, ilo, ihi, s, info )
129  CALL chkxer( 'CGEBAL', infot, nout, lerr, ok )
130  infot = 2
131  CALL cgebal( 'N', -1, a, 1, ilo, ihi, s, info )
132  CALL chkxer( 'CGEBAL', infot, nout, lerr, ok )
133  infot = 4
134  CALL cgebal( 'N', 2, a, 1, ilo, ihi, s, info )
135  CALL chkxer( 'CGEBAL', infot, nout, lerr, ok )
136  nt = nt + 3
137 *
138 * CGEBAK
139 *
140  srnamt = 'CGEBAK'
141  infot = 1
142  CALL cgebak( '/', 'R', 0, 1, 0, s, 0, a, 1, info )
143  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
144  infot = 2
145  CALL cgebak( 'N', '/', 0, 1, 0, s, 0, a, 1, info )
146  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
147  infot = 3
148  CALL cgebak( 'N', 'R', -1, 1, 0, s, 0, a, 1, info )
149  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
150  infot = 4
151  CALL cgebak( 'N', 'R', 0, 0, 0, s, 0, a, 1, info )
152  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
153  infot = 4
154  CALL cgebak( 'N', 'R', 0, 2, 0, s, 0, a, 1, info )
155  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
156  infot = 5
157  CALL cgebak( 'N', 'R', 2, 2, 1, s, 0, a, 2, info )
158  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
159  infot = 5
160  CALL cgebak( 'N', 'R', 0, 1, 1, s, 0, a, 1, info )
161  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
162  infot = 7
163  CALL cgebak( 'N', 'R', 0, 1, 0, s, -1, a, 1, info )
164  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
165  infot = 9
166  CALL cgebak( 'N', 'R', 2, 1, 2, s, 0, a, 1, info )
167  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
168  nt = nt + 9
169 *
170 * CGEHRD
171 *
172  srnamt = 'CGEHRD'
173  infot = 1
174  CALL cgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
175  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
176  infot = 2
177  CALL cgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
178  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
179  infot = 2
180  CALL cgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
181  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
182  infot = 3
183  CALL cgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
184  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
185  infot = 3
186  CALL cgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
187  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
188  infot = 5
189  CALL cgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
190  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
191  infot = 8
192  CALL cgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
193  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
194  nt = nt + 7
195 *
196 * CUNGHR
197 *
198  srnamt = 'CUNGHR'
199  infot = 1
200  CALL cunghr( -1, 1, 1, a, 1, tau, w, 1, info )
201  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
202  infot = 2
203  CALL cunghr( 0, 0, 0, a, 1, tau, w, 1, info )
204  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
205  infot = 2
206  CALL cunghr( 0, 2, 0, a, 1, tau, w, 1, info )
207  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
208  infot = 3
209  CALL cunghr( 1, 1, 0, a, 1, tau, w, 1, info )
210  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
211  infot = 3
212  CALL cunghr( 0, 1, 1, a, 1, tau, w, 1, info )
213  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
214  infot = 5
215  CALL cunghr( 2, 1, 1, a, 1, tau, w, 1, info )
216  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
217  infot = 8
218  CALL cunghr( 3, 1, 3, a, 3, tau, w, 1, info )
219  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
220  nt = nt + 7
221 *
222 * CUNMHR
223 *
224  srnamt = 'CUNMHR'
225  infot = 1
226  CALL cunmhr( '/', 'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
227  $ info )
228  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
229  infot = 2
230  CALL cunmhr( 'L', '/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
231  $ info )
232  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
233  infot = 3
234  CALL cunmhr( 'L', 'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
235  $ info )
236  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
237  infot = 4
238  CALL cunmhr( 'L', 'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
239  $ info )
240  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
241  infot = 5
242  CALL cunmhr( 'L', 'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
243  $ info )
244  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
245  infot = 5
246  CALL cunmhr( 'L', 'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
247  $ info )
248  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
249  infot = 5
250  CALL cunmhr( 'L', 'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
251  $ info )
252  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
253  infot = 5
254  CALL cunmhr( 'R', 'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
255  $ info )
256  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
257  infot = 6
258  CALL cunmhr( 'L', 'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
259  $ info )
260  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
261  infot = 6
262  CALL cunmhr( 'L', 'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
263  $ info )
264  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
265  infot = 6
266  CALL cunmhr( 'R', 'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
267  $ info )
268  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
269  infot = 8
270  CALL cunmhr( 'L', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
271  $ info )
272  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
273  infot = 8
274  CALL cunmhr( 'R', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
275  $ info )
276  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
277  infot = 11
278  CALL cunmhr( 'L', 'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
279  $ info )
280  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
281  infot = 13
282  CALL cunmhr( 'L', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
283  $ info )
284  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
285  infot = 13
286  CALL cunmhr( 'R', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
287  $ info )
288  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
289  nt = nt + 16
290 *
291 * CHSEQR
292 *
293  srnamt = 'CHSEQR'
294  infot = 1
295  CALL chseqr( '/', 'N', 0, 1, 0, a, 1, x, c, 1, w, 1,
296  $ info )
297  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
298  infot = 2
299  CALL chseqr( 'E', '/', 0, 1, 0, a, 1, x, c, 1, w, 1,
300  $ info )
301  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
302  infot = 3
303  CALL chseqr( 'E', 'N', -1, 1, 0, a, 1, x, c, 1, w, 1,
304  $ info )
305  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
306  infot = 4
307  CALL chseqr( 'E', 'N', 0, 0, 0, a, 1, x, c, 1, w, 1,
308  $ info )
309  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
310  infot = 4
311  CALL chseqr( 'E', 'N', 0, 2, 0, a, 1, x, c, 1, w, 1,
312  $ info )
313  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
314  infot = 5
315  CALL chseqr( 'E', 'N', 1, 1, 0, a, 1, x, c, 1, w, 1,
316  $ info )
317  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
318  infot = 5
319  CALL chseqr( 'E', 'N', 1, 1, 2, a, 1, x, c, 1, w, 1,
320  $ info )
321  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
322  infot = 7
323  CALL chseqr( 'E', 'N', 2, 1, 2, a, 1, x, c, 2, w, 1,
324  $ info )
325  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
326  infot = 10
327  CALL chseqr( 'E', 'V', 2, 1, 2, a, 2, x, c, 1, w, 1,
328  $ info )
329  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
330  nt = nt + 9
331 *
332 * CHSEIN
333 *
334  srnamt = 'CHSEIN'
335  infot = 1
336  CALL chsein( '/', 'N', 'N', sel, 0, a, 1, x, vl, 1, vr, 1,
337  $ 0, m, w, rw, ifaill, ifailr, info )
338  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
339  infot = 2
340  CALL chsein( 'R', '/', 'N', sel, 0, a, 1, x, vl, 1, vr, 1,
341  $ 0, m, w, rw, ifaill, ifailr, info )
342  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
343  infot = 3
344  CALL chsein( 'R', 'N', '/', sel, 0, a, 1, x, vl, 1, vr, 1,
345  $ 0, m, w, rw, ifaill, ifailr, info )
346  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
347  infot = 5
348  CALL chsein( 'R', 'N', 'N', sel, -1, a, 1, x, vl, 1, vr,
349  $ 1, 0, m, w, rw, ifaill, ifailr, info )
350  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
351  infot = 7
352  CALL chsein( 'R', 'N', 'N', sel, 2, a, 1, x, vl, 1, vr, 2,
353  $ 4, m, w, rw, ifaill, ifailr, info )
354  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
355  infot = 10
356  CALL chsein( 'L', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 1,
357  $ 4, m, w, rw, ifaill, ifailr, info )
358  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
359  infot = 12
360  CALL chsein( 'R', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 1,
361  $ 4, m, w, rw, ifaill, ifailr, info )
362  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
363  infot = 13
364  CALL chsein( 'R', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 2,
365  $ 1, m, w, rw, ifaill, ifailr, info )
366  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
367  nt = nt + 8
368 *
369 * CTREVC
370 *
371  srnamt = 'CTREVC'
372  infot = 1
373  CALL ctrevc( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
374  $ rw, info )
375  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
376  infot = 2
377  CALL ctrevc( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
378  $ rw, info )
379  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
380  infot = 4
381  CALL ctrevc( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
382  $ rw, info )
383  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
384  infot = 6
385  CALL ctrevc( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
386  $ rw, info )
387  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
388  infot = 8
389  CALL ctrevc( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
390  $ rw, info )
391  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
392  infot = 10
393  CALL ctrevc( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
394  $ rw, info )
395  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
396  infot = 11
397  CALL ctrevc( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
398  $ rw, info )
399  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
400  nt = nt + 7
401  END IF
402 *
403 * Print a summary line.
404 *
405  IF( ok ) THEN
406  WRITE( nout, fmt = 9999 )path, nt
407  ELSE
408  WRITE( nout, fmt = 9998 )path
409  END IF
410 *
411  9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits',
412  $ ' (', i3, ' tests done)' )
413  9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
414  $ 'exits ***' )
415 *
416  RETURN
417 *
418 * End of CERRHS
419 *
420  END
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
cerrhs
subroutine cerrhs(PATH, NUNIT)
CERRHS
Definition: cerrhs.f:55
cgehrd
subroutine cgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CGEHRD
Definition: cgehrd.f:167
cgebal
subroutine cgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
CGEBAL
Definition: cgebal.f:161
cgebak
subroutine cgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
CGEBAK
Definition: cgebak.f:131
cunmhr
subroutine cunmhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMHR
Definition: cunmhr.f:179
cunghr
subroutine cunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CUNGHR
Definition: cunghr.f:126
chseqr
subroutine chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR
Definition: chseqr.f:299
chsein
subroutine chsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL, IFAILR, INFO)
CHSEIN
Definition: chsein.f:245
ctrevc
subroutine ctrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
CTREVC
Definition: ctrevc.f:218