LAPACK  3.9.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.
Date
December 2016

Definition at line 57 of file cerrhs.f.

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