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

◆ zerrhs()

subroutine zerrhs ( character*3  PATH,
integer  NUNIT 
)

ZERRHS

Purpose:
 ZERRHS tests the error exits for ZGEBAK, ZGEBAL, ZGEHRD, ZUNGHR,
 ZUNMHR, ZHSEQR, ZHSEIN, ZTREVC, and ZTREVC3.
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 zerrhs.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 DOUBLE PRECISION RW( NMAX ), S( NMAX )
79 COMPLEX*16 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, zgebak, zgebal, zgehrd, zhsein, zhseqr,
89 $ zunghr, zunmhr, ztrevc, ztrevc3
90* ..
91* .. Intrinsic Functions ..
92 INTRINSIC dble
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.d0 / dble( 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* ZGEBAL
125*
126 srnamt = 'ZGEBAL'
127 infot = 1
128 CALL zgebal( '/', 0, a, 1, ilo, ihi, s, info )
129 CALL chkxer( 'ZGEBAL', infot, nout, lerr, ok )
130 infot = 2
131 CALL zgebal( 'N', -1, a, 1, ilo, ihi, s, info )
132 CALL chkxer( 'ZGEBAL', infot, nout, lerr, ok )
133 infot = 4
134 CALL zgebal( 'N', 2, a, 1, ilo, ihi, s, info )
135 CALL chkxer( 'ZGEBAL', infot, nout, lerr, ok )
136 nt = nt + 3
137*
138* ZGEBAK
139*
140 srnamt = 'ZGEBAK'
141 infot = 1
142 CALL zgebak( '/', 'R', 0, 1, 0, s, 0, a, 1, info )
143 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
144 infot = 2
145 CALL zgebak( 'N', '/', 0, 1, 0, s, 0, a, 1, info )
146 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
147 infot = 3
148 CALL zgebak( 'N', 'R', -1, 1, 0, s, 0, a, 1, info )
149 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
150 infot = 4
151 CALL zgebak( 'N', 'R', 0, 0, 0, s, 0, a, 1, info )
152 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
153 infot = 4
154 CALL zgebak( 'N', 'R', 0, 2, 0, s, 0, a, 1, info )
155 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
156 infot = 5
157 CALL zgebak( 'N', 'R', 2, 2, 1, s, 0, a, 2, info )
158 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
159 infot = 5
160 CALL zgebak( 'N', 'R', 0, 1, 1, s, 0, a, 1, info )
161 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
162 infot = 7
163 CALL zgebak( 'N', 'R', 0, 1, 0, s, -1, a, 1, info )
164 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
165 infot = 9
166 CALL zgebak( 'N', 'R', 2, 1, 2, s, 0, a, 1, info )
167 CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
168 nt = nt + 9
169*
170* ZGEHRD
171*
172 srnamt = 'ZGEHRD'
173 infot = 1
174 CALL zgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
175 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
176 infot = 2
177 CALL zgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
178 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
179 infot = 2
180 CALL zgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
181 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
182 infot = 3
183 CALL zgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
184 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
185 infot = 3
186 CALL zgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
187 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
188 infot = 5
189 CALL zgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
190 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
191 infot = 8
192 CALL zgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
193 CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
194 nt = nt + 7
195*
196* ZUNGHR
197*
198 srnamt = 'ZUNGHR'
199 infot = 1
200 CALL zunghr( -1, 1, 1, a, 1, tau, w, 1, info )
201 CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
202 infot = 2
203 CALL zunghr( 0, 0, 0, a, 1, tau, w, 1, info )
204 CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
205 infot = 2
206 CALL zunghr( 0, 2, 0, a, 1, tau, w, 1, info )
207 CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
208 infot = 3
209 CALL zunghr( 1, 1, 0, a, 1, tau, w, 1, info )
210 CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
211 infot = 3
212 CALL zunghr( 0, 1, 1, a, 1, tau, w, 1, info )
213 CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
214 infot = 5
215 CALL zunghr( 2, 1, 1, a, 1, tau, w, 1, info )
216 CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
217 infot = 8
218 CALL zunghr( 3, 1, 3, a, 3, tau, w, 1, info )
219 CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
220 nt = nt + 7
221*
222* ZUNMHR
223*
224 srnamt = 'ZUNMHR'
225 infot = 1
226 CALL zunmhr( '/', 'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
227 $ info )
228 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
229 infot = 2
230 CALL zunmhr( 'L', '/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
231 $ info )
232 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
233 infot = 3
234 CALL zunmhr( 'L', 'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
235 $ info )
236 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
237 infot = 4
238 CALL zunmhr( 'L', 'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
239 $ info )
240 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
241 infot = 5
242 CALL zunmhr( 'L', 'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
243 $ info )
244 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
245 infot = 5
246 CALL zunmhr( 'L', 'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
247 $ info )
248 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
249 infot = 5
250 CALL zunmhr( 'L', 'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
251 $ info )
252 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
253 infot = 5
254 CALL zunmhr( 'R', 'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
255 $ info )
256 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
257 infot = 6
258 CALL zunmhr( 'L', 'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
259 $ info )
260 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
261 infot = 6
262 CALL zunmhr( 'L', 'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
263 $ info )
264 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
265 infot = 6
266 CALL zunmhr( 'R', 'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
267 $ info )
268 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
269 infot = 8
270 CALL zunmhr( 'L', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
271 $ info )
272 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
273 infot = 8
274 CALL zunmhr( 'R', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
275 $ info )
276 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
277 infot = 11
278 CALL zunmhr( 'L', 'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
279 $ info )
280 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
281 infot = 13
282 CALL zunmhr( 'L', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
283 $ info )
284 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
285 infot = 13
286 CALL zunmhr( 'R', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
287 $ info )
288 CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
289 nt = nt + 16
290*
291* ZHSEQR
292*
293 srnamt = 'ZHSEQR'
294 infot = 1
295 CALL zhseqr( '/', 'N', 0, 1, 0, a, 1, x, c, 1, w, 1, info )
296 CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
297 infot = 2
298 CALL zhseqr( 'E', '/', 0, 1, 0, a, 1, x, c, 1, w, 1, info )
299 CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
300 infot = 3
301 CALL zhseqr( 'E', 'N', -1, 1, 0, a, 1, x, c, 1, w, 1, info )
302 CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
303 infot = 4
304 CALL zhseqr( 'E', 'N', 0, 0, 0, a, 1, x, c, 1, w, 1, info )
305 CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
306 infot = 4
307 CALL zhseqr( 'E', 'N', 0, 2, 0, a, 1, x, c, 1, w, 1, info )
308 CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
309 infot = 5
310 CALL zhseqr( 'E', 'N', 1, 1, 0, a, 1, x, c, 1, w, 1, info )
311 CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
312 infot = 5
313 CALL zhseqr( 'E', 'N', 1, 1, 2, a, 1, x, c, 1, w, 1, info )
314 CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
315 infot = 7
316 CALL zhseqr( 'E', 'N', 2, 1, 2, a, 1, x, c, 2, w, 1, info )
317 CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
318 infot = 10
319 CALL zhseqr( 'E', 'V', 2, 1, 2, a, 2, x, c, 1, w, 1, info )
320 CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
321 nt = nt + 9
322*
323* ZHSEIN
324*
325 srnamt = 'ZHSEIN'
326 infot = 1
327 CALL zhsein( '/', 'N', 'N', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
328 $ m, w, rw, ifaill, ifailr, info )
329 CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
330 infot = 2
331 CALL zhsein( 'R', '/', 'N', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
332 $ m, w, rw, ifaill, ifailr, info )
333 CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
334 infot = 3
335 CALL zhsein( 'R', 'N', '/', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
336 $ m, w, rw, ifaill, ifailr, info )
337 CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
338 infot = 5
339 CALL zhsein( 'R', 'N', 'N', sel, -1, a, 1, x, vl, 1, vr, 1, 0,
340 $ m, w, rw, ifaill, ifailr, info )
341 CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
342 infot = 7
343 CALL zhsein( 'R', 'N', 'N', sel, 2, a, 1, x, vl, 1, vr, 2, 4,
344 $ m, w, rw, ifaill, ifailr, info )
345 CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
346 infot = 10
347 CALL zhsein( 'L', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 1, 4,
348 $ m, w, rw, ifaill, ifailr, info )
349 CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
350 infot = 12
351 CALL zhsein( 'R', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 1, 4,
352 $ m, w, rw, ifaill, ifailr, info )
353 CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
354 infot = 13
355 CALL zhsein( 'R', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 2, 1,
356 $ m, w, rw, ifaill, ifailr, info )
357 CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
358 nt = nt + 8
359*
360* ZTREVC
361*
362 srnamt = 'ZTREVC'
363 infot = 1
364 CALL ztrevc( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w, rw,
365 $ info )
366 CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
367 infot = 2
368 CALL ztrevc( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w, rw,
369 $ info )
370 CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
371 infot = 4
372 CALL ztrevc( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
373 $ rw, info )
374 CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
375 infot = 6
376 CALL ztrevc( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w, rw,
377 $ info )
378 CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
379 infot = 8
380 CALL ztrevc( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w, rw,
381 $ info )
382 CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
383 infot = 10
384 CALL ztrevc( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w, rw,
385 $ info )
386 CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
387 infot = 11
388 CALL ztrevc( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w, rw,
389 $ info )
390 CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
391 nt = nt + 7
392*
393* ZTREVC3
394*
395 srnamt = 'ZTREVC3'
396 infot = 1
397 CALL ztrevc3( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
398 $ lw, rw, 1, info )
399 CALL chkxer( 'ZTREVC3', infot, nout, lerr, ok )
400 infot = 2
401 CALL ztrevc3( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
402 $ lw, rw, 1, info )
403 CALL chkxer( 'ZTREVC3', infot, nout, lerr, ok )
404 infot = 4
405 CALL ztrevc3( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
406 $ lw, rw, 1, info )
407 CALL chkxer( 'ZTREVC3', infot, nout, lerr, ok )
408 infot = 6
409 CALL ztrevc3( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
410 $ lw, rw, 2, info )
411 CALL chkxer( 'ZTREVC3', infot, nout, lerr, ok )
412 infot = 8
413 CALL ztrevc3( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
414 $ lw, rw, 2, info )
415 CALL chkxer( 'ZTREVC3', infot, nout, lerr, ok )
416 infot = 10
417 CALL ztrevc3( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
418 $ lw, rw, 2, info )
419 CALL chkxer( 'ZTREVC3', infot, nout, lerr, ok )
420 infot = 11
421 CALL ztrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
422 $ lw, rw, 2, info )
423 CALL chkxer( 'ZTREVC3', infot, nout, lerr, ok )
424 infot = 14
425 CALL ztrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
426 $ 2, rw, 2, info )
427 CALL chkxer( 'ZTREVC3', infot, nout, lerr, ok )
428 infot = 16
429 CALL ztrevc3( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 2, m, w,
430 $ lw, rw, 1, info )
431 CALL chkxer( 'ZTREVC3', infot, nout, lerr, ok )
432 nt = nt + 9
433 END IF
434*
435* Print a summary line.
436*
437 IF( ok ) THEN
438 WRITE( nout, fmt = 9999 )path, nt
439 ELSE
440 WRITE( nout, fmt = 9998 )path
441 END IF
442*
443 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits',
444 $ ' (', i3, ' tests done)' )
445 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
446 $ 'exits ***' )
447*
448 RETURN
449*
450* End of ZERRHS
451*
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3224
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
zgebal
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
Definition: zgebal.f:162
zgehrd
subroutine zgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZGEHRD
Definition: zgehrd.f:167
zgebak
subroutine zgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
ZGEBAK
Definition: zgebak.f:131
zunmhr
subroutine zunmhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMHR
Definition: zunmhr.f:178
zhseqr
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
Definition: zhseqr.f:299
ztrevc
subroutine ztrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
ZTREVC
Definition: ztrevc.f:218
zhsein
subroutine zhsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL, IFAILR, INFO)
ZHSEIN
Definition: zhsein.f:245
ztrevc3
subroutine ztrevc3(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO)
ZTREVC3
Definition: ztrevc3.f:244
zunghr
subroutine zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
Definition: zunghr.f:126
Here is the call graph for this function:
Here is the caller graph for this function: