LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ cerrhs()

subroutine cerrhs ( character*3  path,
integer  nunit 
)

CERRHS

Purpose:
 CERRHS tests the error exits for CGEBAK, CGEBAL, CGEHRD, CGEHD2,
 CUNGHR, CUNMHR, CHSEQR, CHSEIN, CTREVC, and CTREVC3.
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,
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* CGEHD2
197*
198 srnamt = 'CGEHD2'
199 infot = 1
200 CALL cgehd2( -1, 1, 1, a, 1, tau, w, info )
201 CALL chkxer( 'CGEHD2', infot, nout, lerr, ok )
202 infot = 2
203 CALL cgehd2( 0, 0, 0, a, 1, tau, w, info )
204 CALL chkxer( 'CGEHD2', infot, nout, lerr, ok )
205 infot = 2
206 CALL cgehd2( 0, 2, 0, a, 1, tau, w, info )
207 CALL chkxer( 'CGEHD2', infot, nout, lerr, ok )
208 infot = 3
209 CALL cgehd2( 1, 1, 0, a, 1, tau, w, info )
210 CALL chkxer( 'CGEHD2', infot, nout, lerr, ok )
211 infot = 3
212 CALL cgehd2( 0, 1, 1, a, 1, tau, w, info )
213 CALL chkxer( 'CGEHD2', infot, nout, lerr, ok )
214 infot = 5
215 CALL cgehd2( 2, 1, 1, a, 1, tau, w, info )
216 CALL chkxer( 'CGEHD2', infot, nout, lerr, ok )
217 nt = nt + 6
218*
219* CUNGHR
220*
221 srnamt = 'CUNGHR'
222 infot = 1
223 CALL cunghr( -1, 1, 1, a, 1, tau, w, 1, info )
224 CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
225 infot = 2
226 CALL cunghr( 0, 0, 0, a, 1, tau, w, 1, info )
227 CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
228 infot = 2
229 CALL cunghr( 0, 2, 0, a, 1, tau, w, 1, info )
230 CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
231 infot = 3
232 CALL cunghr( 1, 1, 0, a, 1, tau, w, 1, info )
233 CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
234 infot = 3
235 CALL cunghr( 0, 1, 1, a, 1, tau, w, 1, info )
236 CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
237 infot = 5
238 CALL cunghr( 2, 1, 1, a, 1, tau, w, 1, info )
239 CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
240 infot = 8
241 CALL cunghr( 3, 1, 3, a, 3, tau, w, 1, info )
242 CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
243 nt = nt + 7
244*
245* CUNMHR
246*
247 srnamt = 'CUNMHR'
248 infot = 1
249 CALL cunmhr( '/', 'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
250 $ info )
251 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
252 infot = 2
253 CALL cunmhr( 'L', '/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
254 $ info )
255 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
256 infot = 3
257 CALL cunmhr( 'L', 'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
258 $ info )
259 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
260 infot = 4
261 CALL cunmhr( 'L', 'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
262 $ info )
263 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
264 infot = 5
265 CALL cunmhr( 'L', 'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
266 $ info )
267 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
268 infot = 5
269 CALL cunmhr( 'L', 'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
270 $ info )
271 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
272 infot = 5
273 CALL cunmhr( 'L', 'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
274 $ info )
275 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
276 infot = 5
277 CALL cunmhr( 'R', 'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
278 $ info )
279 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
280 infot = 6
281 CALL cunmhr( 'L', 'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
282 $ info )
283 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
284 infot = 6
285 CALL cunmhr( 'L', 'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
286 $ info )
287 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
288 infot = 6
289 CALL cunmhr( 'R', 'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
290 $ info )
291 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
292 infot = 8
293 CALL cunmhr( 'L', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
294 $ info )
295 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
296 infot = 8
297 CALL cunmhr( 'R', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
298 $ info )
299 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
300 infot = 11
301 CALL cunmhr( 'L', 'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
302 $ info )
303 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
304 infot = 13
305 CALL cunmhr( 'L', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
306 $ info )
307 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
308 infot = 13
309 CALL cunmhr( 'R', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
310 $ info )
311 CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
312 nt = nt + 16
313*
314* CHSEQR
315*
316 srnamt = 'CHSEQR'
317 infot = 1
318 CALL chseqr( '/', 'N', 0, 1, 0, a, 1, x, c, 1, w, 1,
319 $ info )
320 CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
321 infot = 2
322 CALL chseqr( 'E', '/', 0, 1, 0, a, 1, x, c, 1, w, 1,
323 $ info )
324 CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
325 infot = 3
326 CALL chseqr( 'E', 'N', -1, 1, 0, a, 1, x, c, 1, w, 1,
327 $ info )
328 CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
329 infot = 4
330 CALL chseqr( 'E', 'N', 0, 0, 0, a, 1, x, c, 1, w, 1,
331 $ info )
332 CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
333 infot = 4
334 CALL chseqr( 'E', 'N', 0, 2, 0, a, 1, x, c, 1, w, 1,
335 $ info )
336 CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
337 infot = 5
338 CALL chseqr( 'E', 'N', 1, 1, 0, a, 1, x, c, 1, w, 1,
339 $ info )
340 CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
341 infot = 5
342 CALL chseqr( 'E', 'N', 1, 1, 2, a, 1, x, c, 1, w, 1,
343 $ info )
344 CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
345 infot = 7
346 CALL chseqr( 'E', 'N', 2, 1, 2, a, 1, x, c, 2, w, 1,
347 $ info )
348 CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
349 infot = 10
350 CALL chseqr( 'E', 'V', 2, 1, 2, a, 2, x, c, 1, w, 1,
351 $ info )
352 CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
353 nt = nt + 9
354*
355* CHSEIN
356*
357 srnamt = 'CHSEIN'
358 infot = 1
359 CALL chsein( '/', 'N', 'N', sel, 0, a, 1, x, vl, 1, vr, 1,
360 $ 0, m, w, rw, ifaill, ifailr, info )
361 CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
362 infot = 2
363 CALL chsein( 'R', '/', 'N', sel, 0, a, 1, x, vl, 1, vr, 1,
364 $ 0, m, w, rw, ifaill, ifailr, info )
365 CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
366 infot = 3
367 CALL chsein( 'R', 'N', '/', sel, 0, a, 1, x, vl, 1, vr, 1,
368 $ 0, m, w, rw, ifaill, ifailr, info )
369 CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
370 infot = 5
371 CALL chsein( 'R', 'N', 'N', sel, -1, a, 1, x, vl, 1, vr,
372 $ 1, 0, m, w, rw, ifaill, ifailr, info )
373 CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
374 infot = 7
375 CALL chsein( 'R', 'N', 'N', sel, 2, a, 1, x, vl, 1, vr, 2,
376 $ 4, m, w, rw, ifaill, ifailr, info )
377 CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
378 infot = 10
379 CALL chsein( 'L', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 1,
380 $ 4, m, w, rw, ifaill, ifailr, info )
381 CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
382 infot = 12
383 CALL chsein( 'R', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 1,
384 $ 4, m, w, rw, ifaill, ifailr, info )
385 CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
386 infot = 13
387 CALL chsein( 'R', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 2,
388 $ 1, m, w, rw, ifaill, ifailr, info )
389 CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
390 nt = nt + 8
391*
392* CTREVC
393*
394 srnamt = 'CTREVC'
395 infot = 1
396 CALL ctrevc( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
397 $ rw, info )
398 CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
399 infot = 2
400 CALL ctrevc( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
401 $ rw, info )
402 CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
403 infot = 4
404 CALL ctrevc( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
405 $ rw, info )
406 CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
407 infot = 6
408 CALL ctrevc( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
409 $ rw, info )
410 CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
411 infot = 8
412 CALL ctrevc( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
413 $ rw, info )
414 CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
415 infot = 10
416 CALL ctrevc( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
417 $ rw, info )
418 CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
419 infot = 11
420 CALL ctrevc( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
421 $ rw, info )
422 CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
423 nt = nt + 7
424*
425* CTREVC3
426*
427 srnamt = 'CTREVC3'
428 infot = 1
429 CALL ctrevc3( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
430 $ lw, rw, 1, info )
431 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
432 infot = 2
433 CALL ctrevc3( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
434 $ lw, rw, 1, info )
435 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
436 infot = 4
437 CALL ctrevc3( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
438 $ lw, rw, 1, info )
439 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
440 infot = 6
441 CALL ctrevc3( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
442 $ lw, rw, 2, info )
443 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
444 infot = 8
445 CALL ctrevc3( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
446 $ lw, rw, 2, info )
447 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
448 infot = 10
449 CALL ctrevc3( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
450 $ lw, rw, 2, info )
451 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
452 infot = 11
453 CALL ctrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
454 $ lw, rw, 2, info )
455 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
456 infot = 14
457 CALL ctrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
458 $ 2, rw, 2, info )
459 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
460 infot = 16
461 CALL ctrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
462 $ lw, rw, 1, info )
463 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
464 nt = nt + 9
465 END IF
466*
467* Print a summary line.
468*
469 IF( ok ) THEN
470 WRITE( nout, fmt = 9999 )path, nt
471 ELSE
472 WRITE( nout, fmt = 9998 )path
473 END IF
474*
475 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits',
476 $ ' (', i3, ' tests done)' )
477 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
478 $ 'exits ***' )
479*
480 RETURN
481*
482* End of CERRHS
483*
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
subroutine cgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
CGEBAK
Definition cgebak.f:131
subroutine cgebal(job, n, a, lda, ilo, ihi, scale, info)
CGEBAL
Definition cgebal.f:165
subroutine cgehd2(n, ilo, ihi, a, lda, tau, work, info)
CGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm.
Definition cgehd2.f:149
subroutine cgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
CGEHRD
Definition cgehrd.f:167
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
subroutine chseqr(job, compz, n, ilo, ihi, h, ldh, w, z, ldz, work, lwork, info)
CHSEQR
Definition chseqr.f:299
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
subroutine ctrevc3(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, lwork, rwork, lrwork, info)
CTREVC3
Definition ctrevc3.f:244
subroutine ctrevc(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, rwork, info)
CTREVC
Definition ctrevc.f:218
subroutine cunghr(n, ilo, ihi, a, lda, tau, work, lwork, info)
CUNGHR
Definition cunghr.f:126
subroutine cunmhr(side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork, info)
CUNMHR
Definition cunmhr.f:179
Here is the call graph for this function:
Here is the caller graph for this function: