LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cerrhs()

subroutine cerrhs ( character*3  PATH,
integer  NUNIT 
)

CERRHS

Purpose:
 CERRHS tests the error exits for CGEBAK, CGEBAL, CGEHRD, CUNGHR,
 CUNMHR, CHSEQR, CHSEIN, and CTREVC.
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 cerrhs.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*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 *
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
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
Here is the call graph for this function:
Here is the caller graph for this function: