LAPACK 3.11.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, 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* 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*
402* CTREVC3
403*
404 srnamt = 'CTREVC3'
405 infot = 1
406 CALL ctrevc3( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
407 $ lw, rw, 1, info )
408 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
409 infot = 2
410 CALL ctrevc3( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
411 $ lw, rw, 1, info )
412 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
413 infot = 4
414 CALL ctrevc3( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
415 $ lw, rw, 1, info )
416 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
417 infot = 6
418 CALL ctrevc3( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
419 $ lw, rw, 2, info )
420 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
421 infot = 8
422 CALL ctrevc3( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
423 $ lw, rw, 2, info )
424 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
425 infot = 10
426 CALL ctrevc3( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
427 $ lw, rw, 2, info )
428 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
429 infot = 11
430 CALL ctrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
431 $ lw, rw, 2, info )
432 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
433 infot = 14
434 CALL ctrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
435 $ 2, rw, 2, info )
436 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
437 infot = 16
438 CALL ctrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
439 $ lw, rw, 1, info )
440 CALL chkxer( 'CTREVC3', infot, nout, lerr, ok )
441 nt = nt + 9
442 END IF
443*
444* Print a summary line.
445*
446 IF( ok ) THEN
447 WRITE( nout, fmt = 9999 )path, nt
448 ELSE
449 WRITE( nout, fmt = 9998 )path
450 END IF
451*
452 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits',
453 $ ' (', i3, ' tests done)' )
454 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
455 $ 'exits ***' )
456*
457 RETURN
458*
459* End of CERRHS
460*
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3224
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
subroutine cgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CGEHRD
Definition: cgehrd.f:167
subroutine cgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
CGEBAL
Definition: cgebal.f:161
subroutine cgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
CGEBAK
Definition: cgebak.f:131
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 cunmhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMHR
Definition: cunmhr.f:179
subroutine cunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CUNGHR
Definition: cunghr.f:126
subroutine chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR
Definition: chseqr.f:299
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 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: