LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cerrst.f
Go to the documentation of this file.
1*> \brief \b CERRST
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE CERRST( PATH, NUNIT )
12*
13* .. Scalar Arguments ..
14* CHARACTER*3 PATH
15* INTEGER NUNIT
16* ..
17*
18*
19*> \par Purpose:
20* =============
21*>
22*> \verbatim
23*>
24*> CERRST tests the error exits for CHETRD, CHETD2, CUNGTR, CUNMTR, CHPTRD,
25*> CUNGTR, CUPMTR, CSTEQR, CSTEIN, CPTEQR, CHBTRD,
26*> CHEEV, CHEEVX, CHEEVD, CHBEV, CHBEVX, CHBEVD,
27*> CHPEV, CHPEVX, CHPEVD, and CSTEDC.
28*> CHEEVD_2STAGE, CHEEVR_2STAGE, CHEEVX_2STAGE,
29*> CHEEV_2STAGE, CHBEV_2STAGE, CHBEVD_2STAGE,
30*> CHBEVX_2STAGE, CHETRD_2STAGE, CHETRD_HE2HB,
31*> CHETRD_HB2ST
32*> \endverbatim
33*
34* Arguments:
35* ==========
36*
37*> \param[in] PATH
38*> \verbatim
39*> PATH is CHARACTER*3
40*> The LAPACK path name for the routines to be tested.
41*> \endverbatim
42*>
43*> \param[in] NUNIT
44*> \verbatim
45*> NUNIT is INTEGER
46*> The unit number for output.
47*> \endverbatim
48*
49* Authors:
50* ========
51*
52*> \author Univ. of Tennessee
53*> \author Univ. of California Berkeley
54*> \author Univ. of Colorado Denver
55*> \author NAG Ltd.
56*
57*> \ingroup complex_eig
58*
59* =====================================================================
60 SUBROUTINE cerrst( PATH, NUNIT )
61*
62* -- LAPACK test routine --
63* -- LAPACK is a software package provided by Univ. of Tennessee, --
64* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
65*
66* .. Scalar Arguments ..
67 CHARACTER*3 PATH
68 INTEGER NUNIT
69* ..
70*
71* =====================================================================
72*
73* .. Parameters ..
74 INTEGER NMAX, LIW, LW
75 parameter( nmax = 3, liw = 12*nmax, lw = 20*nmax )
76* ..
77* .. Local Scalars ..
78 CHARACTER*2 C2
79 INTEGER I, INFO, J, M, N, NT
80* ..
81* .. Local Arrays ..
82 INTEGER I1( NMAX ), I2( NMAX ), I3( NMAX ), IW( LIW )
83 REAL D( NMAX ), E( NMAX ), R( LW ), RW( LW ),
84 $ X( NMAX )
85 COMPLEX A( NMAX, NMAX ), C( NMAX, NMAX ),
86 $ Q( NMAX, NMAX ), TAU( NMAX ), W( LW ),
87 $ Z( NMAX, NMAX )
88* ..
89* .. External Functions ..
90 LOGICAL LSAMEN
91 EXTERNAL lsamen
92* ..
93* .. External Subroutines ..
94 EXTERNAL chbev, chbevd, chbevx, chbtrd, cheev, cheevd,
102* ..
103* .. Scalars in Common ..
104 LOGICAL LERR, OK
105 CHARACTER*32 SRNAMT
106 INTEGER INFOT, NOUT
107* ..
108* .. Common blocks ..
109 COMMON / infoc / infot, nout, ok, lerr
110 COMMON / srnamc / srnamt
111* ..
112* .. Intrinsic Functions ..
113 INTRINSIC real
114* ..
115* .. Executable Statements ..
116*
117 nout = nunit
118 WRITE( nout, fmt = * )
119 c2 = path( 2: 3 )
120*
121* Set the variables to innocuous values.
122*
123 DO 20 j = 1, nmax
124 DO 10 i = 1, nmax
125 a( i, j ) = 1. / real( i+j )
126 10 CONTINUE
127 20 CONTINUE
128 DO 30 j = 1, nmax
129 d( j ) = real( j )
130 e( j ) = 0.0
131 i1( j ) = j
132 i2( j ) = j
133 tau( j ) = 1.
134 30 CONTINUE
135 ok = .true.
136 nt = 0
137*
138* Test error exits for the ST path.
139*
140 IF( lsamen( 2, c2, 'ST' ) ) THEN
141*
142* CHETRD
143*
144 srnamt = 'CHETRD'
145 infot = 1
146 CALL chetrd( '/', 0, a, 1, d, e, tau, w, 1, info )
147 CALL chkxer( 'CHETRD', infot, nout, lerr, ok )
148 infot = 2
149 CALL chetrd( 'U', -1, a, 1, d, e, tau, w, 1, info )
150 CALL chkxer( 'CHETRD', infot, nout, lerr, ok )
151 infot = 4
152 CALL chetrd( 'U', 2, a, 1, d, e, tau, w, 1, info )
153 CALL chkxer( 'CHETRD', infot, nout, lerr, ok )
154 infot = 9
155 CALL chetrd( 'U', 0, a, 1, d, e, tau, w, 0, info )
156 CALL chkxer( 'CHETRD', infot, nout, lerr, ok )
157 nt = nt + 4
158*
159* CHETD2
160*
161 srnamt = 'CHETD2'
162 infot = 1
163 CALL chetd2( '/', 0, a, 1, d, e, tau, info )
164 CALL chkxer( 'CHETD2', infot, nout, lerr, ok )
165 infot = 2
166 CALL chetd2( 'U', -1, a, 1, d, e, tau, info )
167 CALL chkxer( 'CHETD2', infot, nout, lerr, ok )
168 infot = 4
169 CALL chetd2( 'U', 2, a, 1, d, e, tau, info )
170 CALL chkxer( 'CHETD2', infot, nout, lerr, ok )
171 nt = nt + 3
172*
173* CHETRD_2STAGE
174*
175 srnamt = 'CHETRD_2STAGE'
176 infot = 1
177 CALL chetrd_2stage( '/', 'U', 0, a, 1, d, e, tau,
178 $ c, 1, w, 1, info )
179 CALL chkxer( 'CHETRD_2STAGE', infot, nout, lerr, ok )
180 infot = 1
181 CALL chetrd_2stage( 'H', 'U', 0, a, 1, d, e, tau,
182 $ c, 1, w, 1, info )
183 CALL chkxer( 'CHETRD_2STAGE', infot, nout, lerr, ok )
184 infot = 2
185 CALL chetrd_2stage( 'N', '/', 0, a, 1, d, e, tau,
186 $ c, 1, w, 1, info )
187 CALL chkxer( 'CHETRD_2STAGE', infot, nout, lerr, ok )
188 infot = 3
189 CALL chetrd_2stage( 'N', 'U', -1, a, 1, d, e, tau,
190 $ c, 1, w, 1, info )
191 CALL chkxer( 'CHETRD_2STAGE', infot, nout, lerr, ok )
192 infot = 5
193 CALL chetrd_2stage( 'N', 'U', 2, a, 1, d, e, tau,
194 $ c, 1, w, 1, info )
195 CALL chkxer( 'CHETRD_2STAGE', infot, nout, lerr, ok )
196 infot = 10
197 CALL chetrd_2stage( 'N', 'U', 0, a, 1, d, e, tau,
198 $ c, 0, w, 1, info )
199 CALL chkxer( 'CHETRD_2STAGE', infot, nout, lerr, ok )
200 infot = 12
201 CALL chetrd_2stage( 'N', 'U', 0, a, 1, d, e, tau,
202 $ c, 1, w, 0, info )
203 CALL chkxer( 'CHETRD_2STAGE', infot, nout, lerr, ok )
204 nt = nt + 7
205*
206* CHETRD_HE2HB
207*
208 srnamt = 'CHETRD_HE2HB'
209 infot = 1
210 CALL chetrd_he2hb( '/', 0, 0, a, 1, c, 1, tau, w, 1, info )
211 CALL chkxer( 'CHETRD_HE2HB', infot, nout, lerr, ok )
212 infot = 2
213 CALL chetrd_he2hb( 'U', -1, 0, a, 1, c, 1, tau, w, 1, info )
214 CALL chkxer( 'CHETRD_HE2HB', infot, nout, lerr, ok )
215 infot = 3
216 CALL chetrd_he2hb( 'U', 0, -1, a, 1, c, 1, tau, w, 1, info )
217 CALL chkxer( 'CHETRD_HE2HB', infot, nout, lerr, ok )
218 infot = 5
219 CALL chetrd_he2hb( 'U', 2, 0, a, 1, c, 1, tau, w, 1, info )
220 CALL chkxer( 'CHETRD_HE2HB', infot, nout, lerr, ok )
221 infot = 7
222 CALL chetrd_he2hb( 'U', 0, 2, a, 1, c, 1, tau, w, 1, info )
223 CALL chkxer( 'CHETRD_HE2HB', infot, nout, lerr, ok )
224 infot = 10
225 CALL chetrd_he2hb( 'U', 0, 0, a, 1, c, 1, tau, w, 0, info )
226 CALL chkxer( 'CHETRD_HE2HB', infot, nout, lerr, ok )
227 nt = nt + 6
228*
229* CHETRD_HB2ST
230*
231 srnamt = 'CHETRD_HB2ST'
232 infot = 1
233 CALL chetrd_hb2st( '/', 'N', 'U', 0, 0, a, 1, d, e,
234 $ c, 1, w, 1, info )
235 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
236 infot = 2
237 CALL chetrd_hb2st( 'Y', '/', 'U', 0, 0, a, 1, d, e,
238 $ c, 1, w, 1, info )
239 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
240 infot = 2
241 CALL chetrd_hb2st( 'Y', 'H', 'U', 0, 0, a, 1, d, e,
242 $ c, 1, w, 1, info )
243 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
244 infot = 3
245 CALL chetrd_hb2st( 'Y', 'N', '/', 0, 0, a, 1, d, e,
246 $ c, 1, w, 1, info )
247 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
248 infot = 4
249 CALL chetrd_hb2st( 'Y', 'N', 'U', -1, 0, a, 1, d, e,
250 $ c, 1, w, 1, info )
251 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
252 infot = 5
253 CALL chetrd_hb2st( 'Y', 'N', 'U', 0, -1, a, 1, d, e,
254 $ c, 1, w, 1, info )
255 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
256 infot = 7
257 CALL chetrd_hb2st( 'Y', 'N', 'U', 0, 1, a, 1, d, e,
258 $ c, 1, w, 1, info )
259 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
260 infot = 11
261 CALL chetrd_hb2st( 'Y', 'N', 'U', 0, 0, a, 1, d, e,
262 $ c, 0, w, 1, info )
263 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
264 infot = 13
265 CALL chetrd_hb2st( 'Y', 'N', 'U', 0, 0, a, 1, d, e,
266 $ c, 1, w, 0, info )
267 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
268 nt = nt + 9
269*
270* CUNGTR
271*
272 srnamt = 'CUNGTR'
273 infot = 1
274 CALL cungtr( '/', 0, a, 1, tau, w, 1, info )
275 CALL chkxer( 'CUNGTR', infot, nout, lerr, ok )
276 infot = 2
277 CALL cungtr( 'U', -1, a, 1, tau, w, 1, info )
278 CALL chkxer( 'CUNGTR', infot, nout, lerr, ok )
279 infot = 4
280 CALL cungtr( 'U', 2, a, 1, tau, w, 1, info )
281 CALL chkxer( 'CUNGTR', infot, nout, lerr, ok )
282 infot = 7
283 CALL cungtr( 'U', 3, a, 3, tau, w, 1, info )
284 CALL chkxer( 'CUNGTR', infot, nout, lerr, ok )
285 nt = nt + 4
286*
287* CUNMTR
288*
289 srnamt = 'CUNMTR'
290 infot = 1
291 CALL cunmtr( '/', 'U', 'N', 0, 0, a, 1, tau, c, 1, w, 1, info )
292 CALL chkxer( 'CUNMTR', infot, nout, lerr, ok )
293 infot = 2
294 CALL cunmtr( 'L', '/', 'N', 0, 0, a, 1, tau, c, 1, w, 1, info )
295 CALL chkxer( 'CUNMTR', infot, nout, lerr, ok )
296 infot = 3
297 CALL cunmtr( 'L', 'U', '/', 0, 0, a, 1, tau, c, 1, w, 1, info )
298 CALL chkxer( 'CUNMTR', infot, nout, lerr, ok )
299 infot = 4
300 CALL cunmtr( 'L', 'U', 'N', -1, 0, a, 1, tau, c, 1, w, 1,
301 $ info )
302 CALL chkxer( 'CUNMTR', infot, nout, lerr, ok )
303 infot = 5
304 CALL cunmtr( 'L', 'U', 'N', 0, -1, a, 1, tau, c, 1, w, 1,
305 $ info )
306 CALL chkxer( 'CUNMTR', infot, nout, lerr, ok )
307 infot = 7
308 CALL cunmtr( 'L', 'U', 'N', 2, 0, a, 1, tau, c, 2, w, 1, info )
309 CALL chkxer( 'CUNMTR', infot, nout, lerr, ok )
310 infot = 7
311 CALL cunmtr( 'R', 'U', 'N', 0, 2, a, 1, tau, c, 1, w, 1, info )
312 CALL chkxer( 'CUNMTR', infot, nout, lerr, ok )
313 infot = 10
314 CALL cunmtr( 'L', 'U', 'N', 2, 0, a, 2, tau, c, 1, w, 1, info )
315 CALL chkxer( 'CUNMTR', infot, nout, lerr, ok )
316 infot = 12
317 CALL cunmtr( 'L', 'U', 'N', 0, 2, a, 1, tau, c, 1, w, 1, info )
318 CALL chkxer( 'CUNMTR', infot, nout, lerr, ok )
319 infot = 12
320 CALL cunmtr( 'R', 'U', 'N', 2, 0, a, 1, tau, c, 2, w, 1, info )
321 CALL chkxer( 'CUNMTR', infot, nout, lerr, ok )
322 nt = nt + 10
323*
324* CHPTRD
325*
326 srnamt = 'CHPTRD'
327 infot = 1
328 CALL chptrd( '/', 0, a, d, e, tau, info )
329 CALL chkxer( 'CHPTRD', infot, nout, lerr, ok )
330 infot = 2
331 CALL chptrd( 'U', -1, a, d, e, tau, info )
332 CALL chkxer( 'CHPTRD', infot, nout, lerr, ok )
333 nt = nt + 2
334*
335* CUPGTR
336*
337 srnamt = 'CUPGTR'
338 infot = 1
339 CALL cupgtr( '/', 0, a, tau, z, 1, w, info )
340 CALL chkxer( 'CUPGTR', infot, nout, lerr, ok )
341 infot = 2
342 CALL cupgtr( 'U', -1, a, tau, z, 1, w, info )
343 CALL chkxer( 'CUPGTR', infot, nout, lerr, ok )
344 infot = 6
345 CALL cupgtr( 'U', 2, a, tau, z, 1, w, info )
346 CALL chkxer( 'CUPGTR', infot, nout, lerr, ok )
347 nt = nt + 3
348*
349* CUPMTR
350*
351 srnamt = 'CUPMTR'
352 infot = 1
353 CALL cupmtr( '/', 'U', 'N', 0, 0, a, tau, c, 1, w, info )
354 CALL chkxer( 'CUPMTR', infot, nout, lerr, ok )
355 infot = 2
356 CALL cupmtr( 'L', '/', 'N', 0, 0, a, tau, c, 1, w, info )
357 CALL chkxer( 'CUPMTR', infot, nout, lerr, ok )
358 infot = 3
359 CALL cupmtr( 'L', 'U', '/', 0, 0, a, tau, c, 1, w, info )
360 CALL chkxer( 'CUPMTR', infot, nout, lerr, ok )
361 infot = 4
362 CALL cupmtr( 'L', 'U', 'N', -1, 0, a, tau, c, 1, w, info )
363 CALL chkxer( 'CUPMTR', infot, nout, lerr, ok )
364 infot = 5
365 CALL cupmtr( 'L', 'U', 'N', 0, -1, a, tau, c, 1, w, info )
366 CALL chkxer( 'CUPMTR', infot, nout, lerr, ok )
367 infot = 9
368 CALL cupmtr( 'L', 'U', 'N', 2, 0, a, tau, c, 1, w, info )
369 CALL chkxer( 'CUPMTR', infot, nout, lerr, ok )
370 nt = nt + 6
371*
372* CPTEQR
373*
374 srnamt = 'CPTEQR'
375 infot = 1
376 CALL cpteqr( '/', 0, d, e, z, 1, rw, info )
377 CALL chkxer( 'CPTEQR', infot, nout, lerr, ok )
378 infot = 2
379 CALL cpteqr( 'N', -1, d, e, z, 1, rw, info )
380 CALL chkxer( 'CPTEQR', infot, nout, lerr, ok )
381 infot = 6
382 CALL cpteqr( 'V', 2, d, e, z, 1, rw, info )
383 CALL chkxer( 'CPTEQR', infot, nout, lerr, ok )
384 nt = nt + 3
385*
386* CSTEIN
387*
388 srnamt = 'CSTEIN'
389 infot = 1
390 CALL cstein( -1, d, e, 0, x, i1, i2, z, 1, rw, iw, i3, info )
391 CALL chkxer( 'CSTEIN', infot, nout, lerr, ok )
392 infot = 4
393 CALL cstein( 0, d, e, -1, x, i1, i2, z, 1, rw, iw, i3, info )
394 CALL chkxer( 'CSTEIN', infot, nout, lerr, ok )
395 infot = 4
396 CALL cstein( 0, d, e, 1, x, i1, i2, z, 1, rw, iw, i3, info )
397 CALL chkxer( 'CSTEIN', infot, nout, lerr, ok )
398 infot = 9
399 CALL cstein( 2, d, e, 0, x, i1, i2, z, 1, rw, iw, i3, info )
400 CALL chkxer( 'CSTEIN', infot, nout, lerr, ok )
401 nt = nt + 4
402*
403* CSTEQR
404*
405 srnamt = 'CSTEQR'
406 infot = 1
407 CALL csteqr( '/', 0, d, e, z, 1, rw, info )
408 CALL chkxer( 'CSTEQR', infot, nout, lerr, ok )
409 infot = 2
410 CALL csteqr( 'N', -1, d, e, z, 1, rw, info )
411 CALL chkxer( 'CSTEQR', infot, nout, lerr, ok )
412 infot = 6
413 CALL csteqr( 'V', 2, d, e, z, 1, rw, info )
414 CALL chkxer( 'CSTEQR', infot, nout, lerr, ok )
415 nt = nt + 3
416*
417* CSTEDC
418*
419 srnamt = 'CSTEDC'
420 infot = 1
421 CALL cstedc( '/', 0, d, e, z, 1, w, 1, rw, 1, iw, 1, info )
422 CALL chkxer( 'CSTEDC', infot, nout, lerr, ok )
423 infot = 2
424 CALL cstedc( 'N', -1, d, e, z, 1, w, 1, rw, 1, iw, 1, info )
425 CALL chkxer( 'CSTEDC', infot, nout, lerr, ok )
426 infot = 6
427 CALL cstedc( 'V', 2, d, e, z, 1, w, 4, rw, 23, iw, 28, info )
428 CALL chkxer( 'CSTEDC', infot, nout, lerr, ok )
429 infot = 8
430 CALL cstedc( 'N', 2, d, e, z, 1, w, 0, rw, 1, iw, 1, info )
431 CALL chkxer( 'CSTEDC', infot, nout, lerr, ok )
432 infot = 8
433 CALL cstedc( 'V', 2, d, e, z, 2, w, 0, rw, 23, iw, 28, info )
434 CALL chkxer( 'CSTEDC', infot, nout, lerr, ok )
435 infot = 10
436 CALL cstedc( 'N', 2, d, e, z, 1, w, 1, rw, 0, iw, 1, info )
437 CALL chkxer( 'CSTEDC', infot, nout, lerr, ok )
438 infot = 10
439 CALL cstedc( 'I', 2, d, e, z, 2, w, 1, rw, 1, iw, 12, info )
440 CALL chkxer( 'CSTEDC', infot, nout, lerr, ok )
441 infot = 10
442 CALL cstedc( 'V', 2, d, e, z, 2, w, 4, rw, 1, iw, 28, info )
443 CALL chkxer( 'CSTEDC', infot, nout, lerr, ok )
444 infot = 12
445 CALL cstedc( 'N', 2, d, e, z, 1, w, 1, rw, 1, iw, 0, info )
446 CALL chkxer( 'CSTEDC', infot, nout, lerr, ok )
447 infot = 12
448 CALL cstedc( 'I', 2, d, e, z, 2, w, 1, rw, 23, iw, 0, info )
449 CALL chkxer( 'CSTEDC', infot, nout, lerr, ok )
450 infot = 12
451 CALL cstedc( 'V', 2, d, e, z, 2, w, 4, rw, 23, iw, 0, info )
452 CALL chkxer( 'CSTEDC', infot, nout, lerr, ok )
453 nt = nt + 11
454*
455* CHEEVD
456*
457 srnamt = 'CHEEVD'
458 infot = 1
459 CALL cheevd( '/', 'U', 0, a, 1, x, w, 1, rw, 1, iw, 1, info )
460 CALL chkxer( 'CHEEVD', infot, nout, lerr, ok )
461 infot = 2
462 CALL cheevd( 'N', '/', 0, a, 1, x, w, 1, rw, 1, iw, 1, info )
463 CALL chkxer( 'CHEEVD', infot, nout, lerr, ok )
464 infot = 3
465 CALL cheevd( 'N', 'U', -1, a, 1, x, w, 1, rw, 1, iw, 1, info )
466 CALL chkxer( 'CHEEVD', infot, nout, lerr, ok )
467 infot = 5
468 CALL cheevd( 'N', 'U', 2, a, 1, x, w, 3, rw, 2, iw, 1, info )
469 CALL chkxer( 'CHEEVD', infot, nout, lerr, ok )
470 infot = 8
471 CALL cheevd( 'N', 'U', 1, a, 1, x, w, 0, rw, 1, iw, 1, info )
472 CALL chkxer( 'CHEEVD', infot, nout, lerr, ok )
473 infot = 8
474 CALL cheevd( 'N', 'U', 2, a, 2, x, w, 2, rw, 2, iw, 1, info )
475 CALL chkxer( 'CHEEVD', infot, nout, lerr, ok )
476 infot = 8
477 CALL cheevd( 'V', 'U', 2, a, 2, x, w, 3, rw, 25, iw, 12, info )
478 CALL chkxer( 'CHEEVD', infot, nout, lerr, ok )
479 infot = 10
480 CALL cheevd( 'N', 'U', 1, a, 1, x, w, 1, rw, 0, iw, 1, info )
481 CALL chkxer( 'CHEEVD', infot, nout, lerr, ok )
482 infot = 10
483 CALL cheevd( 'N', 'U', 2, a, 2, x, w, 3, rw, 1, iw, 1, info )
484 CALL chkxer( 'CHEEVD', infot, nout, lerr, ok )
485 infot = 10
486 CALL cheevd( 'V', 'U', 2, a, 2, x, w, 8, rw, 18, iw, 12, info )
487 CALL chkxer( 'CHEEVD', infot, nout, lerr, ok )
488 infot = 12
489 CALL cheevd( 'N', 'U', 1, a, 1, x, w, 1, rw, 1, iw, 0, info )
490 CALL chkxer( 'CHEEVD', infot, nout, lerr, ok )
491 infot = 12
492 CALL cheevd( 'V', 'U', 2, a, 2, x, w, 8, rw, 25, iw, 11, info )
493 CALL chkxer( 'CHEEVD', infot, nout, lerr, ok )
494 nt = nt + 12
495*
496* CHEEVD_2STAGE
497*
498 srnamt = 'CHEEVD_2STAGE'
499 infot = 1
500 CALL cheevd_2stage( '/', 'U', 0, a, 1, x, w, 1,
501 $ rw, 1, iw, 1, info )
502 CALL chkxer( 'CHEEVD_2STAGE', infot, nout, lerr, ok )
503 infot = 1
504 CALL cheevd_2stage( 'V', 'U', 0, a, 1, x, w, 1,
505 $ rw, 1, iw, 1, info )
506 CALL chkxer( 'CHEEVD_2STAGE', infot, nout, lerr, ok )
507 infot = 2
508 CALL cheevd_2stage( 'N', '/', 0, a, 1, x, w, 1,
509 $ rw, 1, iw, 1, info )
510 CALL chkxer( 'CHEEVD_2STAGE', infot, nout, lerr, ok )
511 infot = 3
512 CALL cheevd_2stage( 'N', 'U', -1, a, 1, x, w, 1,
513 $ rw, 1, iw, 1, info )
514 CALL chkxer( 'CHEEVD_2STAGE', infot, nout, lerr, ok )
515 infot = 5
516 CALL cheevd_2stage( 'N', 'U', 2, a, 1, x, w, 3,
517 $ rw, 2, iw, 1, info )
518 CALL chkxer( 'CHEEVD_2STAGE', infot, nout, lerr, ok )
519 infot = 8
520 CALL cheevd_2stage( 'N', 'U', 1, a, 1, x, w, 0,
521 $ rw, 1, iw, 1, info )
522 CALL chkxer( 'CHEEVD_2STAGE', infot, nout, lerr, ok )
523 infot = 8
524 CALL cheevd_2stage( 'N', 'U', 2, a, 2, x, w, 2,
525 $ rw, 2, iw, 1, info )
526 CALL chkxer( 'CHEEVD_2STAGE', infot, nout, lerr, ok )
527* INFOT = 8
528* CALL CHEEVD_2STAGE( 'V', 'U', 2, A, 2, X, W, 3,
529* $ RW, 25, IW, 12, INFO )
530* CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
531 infot = 10
532 CALL cheevd_2stage( 'N', 'U', 1, a, 1, x, w, 1,
533 $ rw, 0, iw, 1, info )
534 CALL chkxer( 'CHEEVD_2STAGE', infot, nout, lerr, ok )
535 infot = 10
536 CALL cheevd_2stage( 'N', 'U', 2, a, 2, x, w, 25,
537 $ rw, 1, iw, 1, info )
538 CALL chkxer( 'CHEEVD_2STAGE', infot, nout, lerr, ok )
539* INFOT = 10
540* CALL CHEEVD_2STAGE( 'V', 'U', 2, A, 2, X, W, 8,
541* $ RW, 18, IW, 12, INFO )
542* CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
543 infot = 12
544 CALL cheevd_2stage( 'N', 'U', 1, a, 1, x, w, 1,
545 $ rw, 1, iw, 0, info )
546 CALL chkxer( 'CHEEVD_2STAGE', infot, nout, lerr, ok )
547 infot = 12
548* CALL CHEEVD_2STAGE( 'V', 'U', 2, A, 2, X, W, 8,
549* $ RW, 25, IW, 11, INFO )
550* CALL CHKXER( 'CHEEVD_2STAGE', INFOT, NOUT, LERR, OK )
551 nt = nt + 10
552*
553* CHEEV
554*
555 srnamt = 'CHEEV '
556 infot = 1
557 CALL cheev( '/', 'U', 0, a, 1, x, w, 1, rw, info )
558 CALL chkxer( 'CHEEV ', infot, nout, lerr, ok )
559 infot = 2
560 CALL cheev( 'N', '/', 0, a, 1, x, w, 1, rw, info )
561 CALL chkxer( 'CHEEV ', infot, nout, lerr, ok )
562 infot = 3
563 CALL cheev( 'N', 'U', -1, a, 1, x, w, 1, rw, info )
564 CALL chkxer( 'CHEEV ', infot, nout, lerr, ok )
565 infot = 5
566 CALL cheev( 'N', 'U', 2, a, 1, x, w, 3, rw, info )
567 CALL chkxer( 'CHEEV ', infot, nout, lerr, ok )
568 infot = 8
569 CALL cheev( 'N', 'U', 2, a, 2, x, w, 2, rw, info )
570 CALL chkxer( 'CHEEV ', infot, nout, lerr, ok )
571 nt = nt + 5
572*
573* CHEEV_2STAGE
574*
575 srnamt = 'CHEEV_2STAGE '
576 infot = 1
577 CALL cheev_2stage( '/', 'U', 0, a, 1, x, w, 1, rw, info )
578 CALL chkxer( 'CHEEV_2STAGE ', infot, nout, lerr, ok )
579 infot = 1
580 CALL cheev_2stage( 'V', 'U', 0, a, 1, x, w, 1, rw, info )
581 CALL chkxer( 'CHEEV_2STAGE ', infot, nout, lerr, ok )
582 infot = 2
583 CALL cheev_2stage( 'N', '/', 0, a, 1, x, w, 1, rw, info )
584 CALL chkxer( 'CHEEV_2STAGE ', infot, nout, lerr, ok )
585 infot = 3
586 CALL cheev_2stage( 'N', 'U', -1, a, 1, x, w, 1, rw, info )
587 CALL chkxer( 'CHEEV_2STAGE ', infot, nout, lerr, ok )
588 infot = 5
589 CALL cheev_2stage( 'N', 'U', 2, a, 1, x, w, 3, rw, info )
590 CALL chkxer( 'CHEEV_2STAGE ', infot, nout, lerr, ok )
591 infot = 8
592 CALL cheev_2stage( 'N', 'U', 2, a, 2, x, w, 2, rw, info )
593 CALL chkxer( 'CHEEV_2STAGE ', infot, nout, lerr, ok )
594 nt = nt + 6
595*
596* CHEEVX
597*
598 srnamt = 'CHEEVX'
599 infot = 1
600 CALL cheevx( '/', 'A', 'U', 0, a, 1, 0.0, 0.0, 0, 0, 0.0, m, x,
601 $ z, 1, w, 1, rw, iw, i3, info )
602 CALL chkxer( 'CHEEVX', infot, nout, lerr, ok )
603 infot = 2
604 CALL cheevx( 'V', '/', 'U', 0, a, 1, 0.0, 1.0, 1, 0, 0.0, m, x,
605 $ z, 1, w, 1, rw, iw, i3, info )
606 CALL chkxer( 'CHEEVX', infot, nout, lerr, ok )
607 infot = 3
608 CALL cheevx( 'V', 'A', '/', 0, a, 1, 0.0, 0.0, 0, 0, 0.0, m, x,
609 $ z, 1, w, 1, rw, iw, i3, info )
610 infot = 4
611 CALL cheevx( 'V', 'A', 'U', -1, a, 1, 0.0, 0.0, 0, 0, 0.0, m,
612 $ x, z, 1, w, 1, rw, iw, i3, info )
613 CALL chkxer( 'CHEEVX', infot, nout, lerr, ok )
614 infot = 6
615 CALL cheevx( 'V', 'A', 'U', 2, a, 1, 0.0, 0.0, 0, 0, 0.0, m, x,
616 $ z, 2, w, 3, rw, iw, i3, info )
617 CALL chkxer( 'CHEEVX', infot, nout, lerr, ok )
618 infot = 8
619 CALL cheevx( 'V', 'V', 'U', 1, a, 1, 0.0, 0.0, 0, 0, 0.0, m, x,
620 $ z, 1, w, 1, rw, iw, i3, info )
621 CALL chkxer( 'CHEEVX', infot, nout, lerr, ok )
622 infot = 9
623 CALL cheevx( 'V', 'I', 'U', 1, a, 1, 0.0, 0.0, 0, 0, 0.0, m, x,
624 $ z, 1, w, 1, rw, iw, i3, info )
625 CALL chkxer( 'CHEEVX', infot, nout, lerr, ok )
626 infot = 10
627 CALL cheevx( 'V', 'I', 'U', 2, a, 2, 0.0, 0.0, 2, 1, 0.0, m, x,
628 $ z, 2, w, 3, rw, iw, i3, info )
629 CALL chkxer( 'CHEEVX', infot, nout, lerr, ok )
630 infot = 15
631 CALL cheevx( 'V', 'A', 'U', 2, a, 2, 0.0, 0.0, 0, 0, 0.0, m, x,
632 $ z, 1, w, 3, rw, iw, i3, info )
633 CALL chkxer( 'CHEEVX', infot, nout, lerr, ok )
634 infot = 17
635 CALL cheevx( 'V', 'A', 'U', 2, a, 2, 0.0, 0.0, 0, 0, 0.0, m, x,
636 $ z, 2, w, 2, rw, iw, i1, info )
637 CALL chkxer( 'CHEEVX', infot, nout, lerr, ok )
638 nt = nt + 10
639*
640* CHEEVX_2STAGE
641*
642 srnamt = 'CHEEVX_2STAGE'
643 infot = 1
644 CALL cheevx_2stage( '/', 'A', 'U', 0, a, 1,
645 $ 0.0, 0.0, 0, 0, 0.0,
646 $ m, x, z, 1, w, 1, rw, iw, i3, info )
647 CALL chkxer( 'CHEEVX_2STAGE', infot, nout, lerr, ok )
648 infot = 1
649 CALL cheevx_2stage( 'V', 'A', 'U', 0, a, 1,
650 $ 0.0, 0.0, 0, 0, 0.0,
651 $ m, x, z, 1, w, 1, rw, iw, i3, info )
652 CALL chkxer( 'CHEEVX_2STAGE', infot, nout, lerr, ok )
653 infot = 2
654 CALL cheevx_2stage( 'N', '/', 'U', 0, a, 1,
655 $ 0.0, 1.0, 1, 0, 0.0,
656 $ m, x, z, 1, w, 1, rw, iw, i3, info )
657 CALL chkxer( 'CHEEVX_2STAGE', infot, nout, lerr, ok )
658 infot = 3
659 CALL cheevx_2stage( 'N', 'A', '/', 0, a, 1,
660 $ 0.0, 0.0, 0, 0, 0.0,
661 $ m, x, z, 1, w, 1, rw, iw, i3, info )
662 infot = 4
663 CALL cheevx_2stage( 'N', 'A', 'U', -1, a, 1,
664 $ 0.0, 0.0, 0, 0, 0.0,
665 $ m, x, z, 1, w, 1, rw, iw, i3, info )
666 CALL chkxer( 'CHEEVX_2STAGE', infot, nout, lerr, ok )
667 infot = 6
668 CALL cheevx_2stage( 'N', 'A', 'U', 2, a, 1,
669 $ 0.0, 0.0, 0, 0, 0.0,
670 $ m, x, z, 2, w, 3, rw, iw, i3, info )
671 CALL chkxer( 'CHEEVX_2STAGE', infot, nout, lerr, ok )
672 infot = 8
673 CALL cheevx_2stage( 'N', 'V', 'U', 1, a, 1,
674 $ 0.0, 0.0, 0, 0, 0.0,
675 $ m, x, z, 1, w, 1, rw, iw, i3, info )
676 CALL chkxer( 'CHEEVX_2STAGE', infot, nout, lerr, ok )
677 infot = 9
678 CALL cheevx_2stage( 'N', 'I', 'U', 1, a, 1,
679 $ 0.0, 0.0, 0, 0, 0.0,
680 $ m, x, z, 1, w, 1, rw, iw, i3, info )
681 CALL chkxer( 'CHEEVX_2STAGE', infot, nout, lerr, ok )
682 infot = 10
683 CALL cheevx_2stage( 'N', 'I', 'U', 2, a, 2,
684 $ 0.0, 0.0, 2, 1, 0.0,
685 $ m, x, z, 2, w, 3, rw, iw, i3, info )
686 CALL chkxer( 'CHEEVX_2STAGE', infot, nout, lerr, ok )
687 infot = 15
688 CALL cheevx_2stage( 'N', 'A', 'U', 2, a, 2,
689 $ 0.0, 0.0, 0, 0, 0.0,
690 $ m, x, z, 0, w, 3, rw, iw, i3, info )
691 CALL chkxer( 'CHEEVX_2STAGE', infot, nout, lerr, ok )
692 infot = 17
693 CALL cheevx_2stage( 'N', 'A', 'U', 2, a, 2,
694 $ 0.0, 0.0, 0, 0, 0.0,
695 $ m, x, z, 2, w, 0, rw, iw, i1, info )
696 CALL chkxer( 'CHEEVX_2STAGE', infot, nout, lerr, ok )
697 nt = nt + 11
698*
699* CHEEVR
700*
701 srnamt = 'CHEEVR'
702 n = 1
703 infot = 1
704 CALL cheevr( '/', 'A', 'U', 0, a, 1, 0.0, 0.0, 1, 1, 0.0, m, r,
705 $ z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ), 10*n,
706 $ info )
707 CALL chkxer( 'CHEEVR', infot, nout, lerr, ok )
708 infot = 2
709 CALL cheevr( 'V', '/', 'U', 0, a, 1, 0.0, 0.0, 1, 1, 0.0, m, r,
710 $ z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ), 10*n,
711 $ info )
712 CALL chkxer( 'CHEEVR', infot, nout, lerr, ok )
713 infot = 3
714 CALL cheevr( 'V', 'A', '/', -1, a, 1, 0.0, 0.0, 1, 1, 0.0, m,
715 $ r, z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ), 10*n,
716 $ info )
717 CALL chkxer( 'CHEEVR', infot, nout, lerr, ok )
718 infot = 4
719 CALL cheevr( 'V', 'A', 'U', -1, a, 1, 0.0, 0.0, 1, 1, 0.0, m,
720 $ r, z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ), 10*n,
721 $ info )
722 CALL chkxer( 'CHEEVR', infot, nout, lerr, ok )
723 infot = 6
724 CALL cheevr( 'V', 'A', 'U', 2, a, 1, 0.0, 0.0, 1, 1, 0.0, m, r,
725 $ z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ), 10*n,
726 $ info )
727 CALL chkxer( 'CHEEVR', infot, nout, lerr, ok )
728 infot = 8
729 CALL cheevr( 'V', 'V', 'U', 1, a, 1, 0.0e0, 0.0e0, 1, 1, 0.0,
730 $ m, r, z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ),
731 $ 10*n, info )
732 CALL chkxer( 'CHEEVR', infot, nout, lerr, ok )
733 infot = 9
734 CALL cheevr( 'V', 'I', 'U', 1, a, 1, 0.0e0, 0.0e0, 0, 1, 0.0,
735 $ m, r, z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ),
736 $ 10*n, info )
737 CALL chkxer( 'CHEEVR', infot, nout, lerr, ok )
738 infot = 10
739*
740 CALL cheevr( 'V', 'I', 'U', 2, a, 2, 0.0e0, 0.0e0, 2, 1, 0.0,
741 $ m, r, z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ),
742 $ 10*n, info )
743 CALL chkxer( 'CHEEVR', infot, nout, lerr, ok )
744 infot = 15
745 CALL cheevr( 'V', 'I', 'U', 1, a, 1, 0.0e0, 0.0e0, 1, 1, 0.0,
746 $ m, r, z, 0, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ),
747 $ 10*n, info )
748 CALL chkxer( 'CHEEVR', infot, nout, lerr, ok )
749 infot = 18
750 CALL cheevr( 'V', 'I', 'U', 1, a, 1, 0.0e0, 0.0e0, 1, 1, 0.0,
751 $ m, r, z, 1, iw, q, 2*n-1, rw, 24*n, iw( 2*n+1 ),
752 $ 10*n, info )
753 CALL chkxer( 'CHEEVR', infot, nout, lerr, ok )
754 infot = 20
755 CALL cheevr( 'V', 'I', 'U', 1, a, 1, 0.0e0, 0.0e0, 1, 1, 0.0,
756 $ m, r, z, 1, iw, q, 2*n, rw, 24*n-1, iw( 2*n-1 ),
757 $ 10*n, info )
758 CALL chkxer( 'CHEEVR', infot, nout, lerr, ok )
759 infot = 22
760 CALL cheevr( 'V', 'I', 'U', 1, a, 1, 0.0e0, 0.0e0, 1, 1, 0.0,
761 $ m, r, z, 1, iw, q, 2*n, rw, 24*n, iw, 10*n-1,
762 $ info )
763 CALL chkxer( 'CHEEVR', infot, nout, lerr, ok )
764 nt = nt + 12
765*
766* CHEEVR_2STAGE
767*
768 srnamt = 'CHEEVR_2STAGE'
769 n = 1
770 infot = 1
771 CALL cheevr_2stage( '/', 'A', 'U', 0, a, 1,
772 $ 0.0, 0.0, 1, 1, 0.0,
773 $ m, r, z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ),
774 $ 10*n, info )
775 CALL chkxer( 'CHEEVR_2STAGE', infot, nout, lerr, ok )
776 infot = 1
777 CALL cheevr_2stage( 'V', 'A', 'U', 0, a, 1,
778 $ 0.0, 0.0, 1, 1, 0.0,
779 $ m, r, z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ),
780 $ 10*n, info )
781 CALL chkxer( 'CHEEVR_2STAGE', infot, nout, lerr, ok )
782 infot = 2
783 CALL cheevr_2stage( 'N', '/', 'U', 0, a, 1,
784 $ 0.0, 0.0, 1, 1, 0.0,
785 $ m, r, z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ),
786 $ 10*n, info )
787 CALL chkxer( 'CHEEVR_2STAGE', infot, nout, lerr, ok )
788 infot = 3
789 CALL cheevr_2stage( 'N', 'A', '/', -1, a, 1,
790 $ 0.0, 0.0, 1, 1, 0.0,
791 $ m, r, z, 1, iw, q, 2*n, rw, 24*n,
792 $ iw( 2*n+1 ), 10*n, info )
793 CALL chkxer( 'CHEEVR_2STAGE', infot, nout, lerr, ok )
794 infot = 4
795 CALL cheevr_2stage( 'N', 'A', 'U', -1, a, 1,
796 $ 0.0, 0.0, 1, 1, 0.0,
797 $ m, r, z, 1, iw, q, 2*n, rw, 24*n,
798 $ iw( 2*n+1 ), 10*n, info )
799 CALL chkxer( 'CHEEVR_2STAGE', infot, nout, lerr, ok )
800 infot = 6
801 CALL cheevr_2stage( 'N', 'A', 'U', 2, a, 1,
802 $ 0.0, 0.0, 1, 1, 0.0,
803 $ m, r, z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ),
804 $ 10*n, info )
805 CALL chkxer( 'CHEEVR_2STAGE', infot, nout, lerr, ok )
806 infot = 8
807 CALL cheevr_2stage( 'N', 'V', 'U', 1, a, 1,
808 $ 0.0, 0.0, 1, 1, 0.0,
809 $ m, r, z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ),
810 $ 10*n, info )
811 CALL chkxer( 'CHEEVR_2STAGE', infot, nout, lerr, ok )
812 infot = 9
813 CALL cheevr_2stage( 'N', 'I', 'U', 1, a, 1,
814 $ 0.0, 0.0, 0, 1, 0.0,
815 $ m, r, z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ),
816 $ 10*n, info )
817 CALL chkxer( 'CHEEVR_2STAGE', infot, nout, lerr, ok )
818 infot = 10
819 CALL cheevr_2stage( 'N', 'I', 'U', 2, a, 2,
820 $ 0.0, 0.0, 2, 1, 0.0,
821 $ m, r, z, 1, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ),
822 $ 10*n, info )
823 CALL chkxer( 'CHEEVR_2STAGE', infot, nout, lerr, ok )
824 infot = 15
825 CALL cheevr_2stage( 'N', 'I', 'U', 1, a, 1,
826 $ 0.0, 0.0, 1, 1, 0.0,
827 $ m, r, z, 0, iw, q, 2*n, rw, 24*n, iw( 2*n+1 ),
828 $ 10*n, info )
829 CALL chkxer( 'CHEEVR_2STAGE', infot, nout, lerr, ok )
830 infot = 18
831 CALL cheevr_2stage( 'N', 'I', 'U', 1, a, 1,
832 $ 0.0, 0.0, 1, 1, 0.0,
833 $ m, r, z, 1, iw, q, 2*n-1, rw, 24*n, iw( 2*n+1 ),
834 $ 10*n, info )
835 CALL chkxer( 'CHEEVR_2STAGE', infot, nout, lerr, ok )
836 infot = 20
837 CALL cheevr_2stage( 'N', 'I', 'U', 1, a, 1,
838 $ 0.0, 0.0, 1, 1, 0.0,
839 $ m, r, z, 1, iw, q, 26*n, rw, 24*n-1, iw( 2*n-1 ),
840 $ 10*n, info )
841 CALL chkxer( 'CHEEVR_2STAGE', infot, nout, lerr, ok )
842 infot = 22
843 CALL cheevr_2stage( 'N', 'I', 'U', 1, a, 1,
844 $ 0.0, 0.0, 1, 1, 0.0,
845 $ m, r, z, 1, iw, q, 26*n, rw, 24*n, iw, 10*n-1,
846 $ info )
847 CALL chkxer( 'CHEEVR_2STAGE', infot, nout, lerr, ok )
848 nt = nt + 13
849*
850* CHPEVD
851*
852 srnamt = 'CHPEVD'
853 infot = 1
854 CALL chpevd( '/', 'U', 0, a, x, z, 1, w, 1, rw, 1, iw, 1,
855 $ info )
856 CALL chkxer( 'CHPEVD', infot, nout, lerr, ok )
857 infot = 2
858 CALL chpevd( 'N', '/', 0, a, x, z, 1, w, 1, rw, 1, iw, 1,
859 $ info )
860 CALL chkxer( 'CHPEVD', infot, nout, lerr, ok )
861 infot = 3
862 CALL chpevd( 'N', 'U', -1, a, x, z, 1, w, 1, rw, 1, iw, 1,
863 $ info )
864 CALL chkxer( 'CHPEVD', infot, nout, lerr, ok )
865 infot = 7
866 CALL chpevd( 'V', 'U', 2, a, x, z, 1, w, 4, rw, 25, iw, 12,
867 $ info )
868 CALL chkxer( 'CHPEVD', infot, nout, lerr, ok )
869 infot = 9
870 CALL chpevd( 'N', 'U', 1, a, x, z, 1, w, 0, rw, 1, iw, 1,
871 $ info )
872 CALL chkxer( 'CHPEVD', infot, nout, lerr, ok )
873 infot = 9
874 CALL chpevd( 'N', 'U', 2, a, x, z, 2, w, 1, rw, 2, iw, 1,
875 $ info )
876 CALL chkxer( 'CHPEVD', infot, nout, lerr, ok )
877 infot = 9
878 CALL chpevd( 'V', 'U', 2, a, x, z, 2, w, 2, rw, 25, iw, 12,
879 $ info )
880 CALL chkxer( 'CHPEVD', infot, nout, lerr, ok )
881 infot = 11
882 CALL chpevd( 'N', 'U', 1, a, x, z, 1, w, 1, rw, 0, iw, 1,
883 $ info )
884 CALL chkxer( 'CHPEVD', infot, nout, lerr, ok )
885 infot = 11
886 CALL chpevd( 'N', 'U', 2, a, x, z, 2, w, 2, rw, 1, iw, 1,
887 $ info )
888 CALL chkxer( 'CHPEVD', infot, nout, lerr, ok )
889 infot = 11
890 CALL chpevd( 'V', 'U', 2, a, x, z, 2, w, 4, rw, 18, iw, 12,
891 $ info )
892 CALL chkxer( 'CHPEVD', infot, nout, lerr, ok )
893 infot = 13
894 CALL chpevd( 'N', 'U', 1, a, x, z, 1, w, 1, rw, 1, iw, 0,
895 $ info )
896 CALL chkxer( 'CHPEVD', infot, nout, lerr, ok )
897 infot = 13
898 CALL chpevd( 'N', 'U', 2, a, x, z, 2, w, 2, rw, 2, iw, 0,
899 $ info )
900 CALL chkxer( 'CHPEVD', infot, nout, lerr, ok )
901 infot = 13
902 CALL chpevd( 'V', 'U', 2, a, x, z, 2, w, 4, rw, 25, iw, 2,
903 $ info )
904 CALL chkxer( 'CHPEVD', infot, nout, lerr, ok )
905 nt = nt + 13
906*
907* CHPEV
908*
909 srnamt = 'CHPEV '
910 infot = 1
911 CALL chpev( '/', 'U', 0, a, x, z, 1, w, rw, info )
912 CALL chkxer( 'CHPEV ', infot, nout, lerr, ok )
913 infot = 2
914 CALL chpev( 'N', '/', 0, a, x, z, 1, w, rw, info )
915 CALL chkxer( 'CHPEV ', infot, nout, lerr, ok )
916 infot = 3
917 CALL chpev( 'N', 'U', -1, a, x, z, 1, w, rw, info )
918 CALL chkxer( 'CHPEV ', infot, nout, lerr, ok )
919 infot = 7
920 CALL chpev( 'V', 'U', 2, a, x, z, 1, w, rw, info )
921 CALL chkxer( 'CHPEV ', infot, nout, lerr, ok )
922 nt = nt + 4
923*
924* CHPEVX
925*
926 srnamt = 'CHPEVX'
927 infot = 1
928 CALL chpevx( '/', 'A', 'U', 0, a, 0.0, 0.0, 0, 0, 0.0, m, x, z,
929 $ 1, w, rw, iw, i3, info )
930 CALL chkxer( 'CHPEVX', infot, nout, lerr, ok )
931 infot = 2
932 CALL chpevx( 'V', '/', 'U', 0, a, 0.0, 1.0, 1, 0, 0.0, m, x, z,
933 $ 1, w, rw, iw, i3, info )
934 CALL chkxer( 'CHPEVX', infot, nout, lerr, ok )
935 infot = 3
936 CALL chpevx( 'V', 'A', '/', 0, a, 0.0, 0.0, 0, 0, 0.0, m, x, z,
937 $ 1, w, rw, iw, i3, info )
938 CALL chkxer( 'CHPEVX', infot, nout, lerr, ok )
939 infot = 4
940 CALL chpevx( 'V', 'A', 'U', -1, a, 0.0, 0.0, 0, 0, 0.0, m, x,
941 $ z, 1, w, rw, iw, i3, info )
942 CALL chkxer( 'CHPEVX', infot, nout, lerr, ok )
943 infot = 7
944 CALL chpevx( 'V', 'V', 'U', 1, a, 0.0, 0.0, 0, 0, 0.0, m, x, z,
945 $ 1, w, rw, iw, i3, info )
946 CALL chkxer( 'CHPEVX', infot, nout, lerr, ok )
947 infot = 8
948 CALL chpevx( 'V', 'I', 'U', 1, a, 0.0, 0.0, 0, 0, 0.0, m, x, z,
949 $ 1, w, rw, iw, i3, info )
950 CALL chkxer( 'CHPEVX', infot, nout, lerr, ok )
951 infot = 9
952 CALL chpevx( 'V', 'I', 'U', 2, a, 0.0, 0.0, 2, 1, 0.0, m, x, z,
953 $ 2, w, rw, iw, i3, info )
954 CALL chkxer( 'CHPEVX', infot, nout, lerr, ok )
955 infot = 14
956 CALL chpevx( 'V', 'A', 'U', 2, a, 0.0, 0.0, 0, 0, 0.0, m, x, z,
957 $ 1, w, rw, iw, i3, info )
958 CALL chkxer( 'CHPEVX', infot, nout, lerr, ok )
959 nt = nt + 8
960*
961* Test error exits for the HB path.
962*
963 ELSE IF( lsamen( 2, c2, 'HB' ) ) THEN
964*
965* CHBTRD
966*
967 srnamt = 'CHBTRD'
968 infot = 1
969 CALL chbtrd( '/', 'U', 0, 0, a, 1, d, e, z, 1, w, info )
970 CALL chkxer( 'CHBTRD', infot, nout, lerr, ok )
971 infot = 2
972 CALL chbtrd( 'N', '/', 0, 0, a, 1, d, e, z, 1, w, info )
973 CALL chkxer( 'CHBTRD', infot, nout, lerr, ok )
974 infot = 3
975 CALL chbtrd( 'N', 'U', -1, 0, a, 1, d, e, z, 1, w, info )
976 CALL chkxer( 'CHBTRD', infot, nout, lerr, ok )
977 infot = 4
978 CALL chbtrd( 'N', 'U', 0, -1, a, 1, d, e, z, 1, w, info )
979 CALL chkxer( 'CHBTRD', infot, nout, lerr, ok )
980 infot = 6
981 CALL chbtrd( 'N', 'U', 1, 1, a, 1, d, e, z, 1, w, info )
982 CALL chkxer( 'CHBTRD', infot, nout, lerr, ok )
983 infot = 10
984 CALL chbtrd( 'V', 'U', 2, 0, a, 1, d, e, z, 1, w, info )
985 CALL chkxer( 'CHBTRD', infot, nout, lerr, ok )
986 nt = nt + 6
987*
988* CHETRD_HB2ST
989*
990 srnamt = 'CHETRD_HB2ST'
991 infot = 1
992 CALL chetrd_hb2st( '/', 'N', 'U', 0, 0, a, 1, d, e,
993 $ c, 1, w, 1, info )
994 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
995 infot = 2
996 CALL chetrd_hb2st( 'N', '/', 'U', 0, 0, a, 1, d, e,
997 $ c, 1, w, 1, info )
998 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
999 infot = 2
1000 CALL chetrd_hb2st( 'N', 'H', 'U', 0, 0, a, 1, d, e,
1001 $ c, 1, w, 1, info )
1002 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
1003 infot = 3
1004 CALL chetrd_hb2st( 'N', 'N', '/', 0, 0, a, 1, d, e,
1005 $ c, 1, w, 1, info )
1006 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
1007 infot = 4
1008 CALL chetrd_hb2st( 'N', 'N', 'U', -1, 0, a, 1, d, e,
1009 $ c, 1, w, 1, info )
1010 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
1011 infot = 5
1012 CALL chetrd_hb2st( 'N', 'N', 'U', 0, -1, a, 1, d, e,
1013 $ c, 1, w, 1, info )
1014 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
1015 infot = 7
1016 CALL chetrd_hb2st( 'N', 'N', 'U', 0, 1, a, 1, d, e,
1017 $ c, 1, w, 1, info )
1018 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
1019 infot = 11
1020 CALL chetrd_hb2st( 'N', 'N', 'U', 0, 0, a, 1, d, e,
1021 $ c, 0, w, 1, info )
1022 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
1023 infot = 13
1024 CALL chetrd_hb2st( 'N', 'N', 'U', 0, 0, a, 1, d, e,
1025 $ c, 1, w, 0, info )
1026 CALL chkxer( 'CHETRD_HB2ST', infot, nout, lerr, ok )
1027 nt = nt + 9
1028*
1029* CHBEVD
1030*
1031 srnamt = 'CHBEVD'
1032 infot = 1
1033 CALL chbevd( '/', 'U', 0, 0, a, 1, x, z, 1, w, 1, rw, 1, iw, 1,
1034 $ info )
1035 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1036 infot = 2
1037 CALL chbevd( 'N', '/', 0, 0, a, 1, x, z, 1, w, 1, rw, 1, iw, 1,
1038 $ info )
1039 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1040 infot = 3
1041 CALL chbevd( 'N', 'U', -1, 0, a, 1, x, z, 1, w, 1, rw, 1, iw,
1042 $ 1, info )
1043 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1044 infot = 4
1045 CALL chbevd( 'N', 'U', 0, -1, a, 1, x, z, 1, w, 1, rw, 1, iw,
1046 $ 1, info )
1047 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1048 infot = 6
1049 CALL chbevd( 'N', 'U', 2, 1, a, 1, x, z, 1, w, 2, rw, 2, iw, 1,
1050 $ info )
1051 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1052 infot = 9
1053 CALL chbevd( 'V', 'U', 2, 1, a, 2, x, z, 1, w, 8, rw, 25, iw,
1054 $ 12, info )
1055 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1056 infot = 11
1057 CALL chbevd( 'N', 'U', 1, 0, a, 1, x, z, 1, w, 0, rw, 1, iw, 1,
1058 $ info )
1059 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1060 infot = 11
1061 CALL chbevd( 'N', 'U', 2, 1, a, 2, x, z, 2, w, 1, rw, 2, iw, 1,
1062 $ info )
1063 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1064 infot = 11
1065 CALL chbevd( 'V', 'U', 2, 1, a, 2, x, z, 2, w, 2, rw, 25, iw,
1066 $ 12, info )
1067 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1068 infot = 13
1069 CALL chbevd( 'N', 'U', 1, 0, a, 1, x, z, 1, w, 1, rw, 0, iw, 1,
1070 $ info )
1071 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1072 infot = 13
1073 CALL chbevd( 'N', 'U', 2, 1, a, 2, x, z, 2, w, 2, rw, 1, iw, 1,
1074 $ info )
1075 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1076 infot = 13
1077 CALL chbevd( 'V', 'U', 2, 1, a, 2, x, z, 2, w, 8, rw, 2, iw,
1078 $ 12, info )
1079 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1080 infot = 15
1081 CALL chbevd( 'N', 'U', 1, 0, a, 1, x, z, 1, w, 1, rw, 1, iw, 0,
1082 $ info )
1083 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1084 infot = 15
1085 CALL chbevd( 'N', 'U', 2, 1, a, 2, x, z, 2, w, 2, rw, 2, iw, 0,
1086 $ info )
1087 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1088 infot = 15
1089 CALL chbevd( 'V', 'U', 2, 1, a, 2, x, z, 2, w, 8, rw, 25, iw,
1090 $ 2, info )
1091 CALL chkxer( 'CHBEVD', infot, nout, lerr, ok )
1092 nt = nt + 15
1093*
1094* CHBEVD_2STAGE
1095*
1096 srnamt = 'CHBEVD_2STAGE'
1097 infot = 1
1098 CALL chbevd_2stage( '/', 'U', 0, 0, a, 1, x, z, 1,
1099 $ w, 1, rw, 1, iw, 1, info )
1100 CALL chkxer( 'CHBEVD_2STAGE', infot, nout, lerr, ok )
1101 infot = 1
1102 CALL chbevd_2stage( 'V', 'U', 0, 0, a, 1, x, z, 1,
1103 $ w, 1, rw, 1, iw, 1, info )
1104 CALL chkxer( 'CHBEVD_2STAGE', infot, nout, lerr, ok )
1105 infot = 2
1106 CALL chbevd_2stage( 'N', '/', 0, 0, a, 1, x, z, 1,
1107 $ w, 1, rw, 1, iw, 1, info )
1108 CALL chkxer( 'CHBEVD_2STAGE', infot, nout, lerr, ok )
1109 infot = 3
1110 CALL chbevd_2stage( 'N', 'U', -1, 0, a, 1, x, z, 1,
1111 $ w, 1, rw, 1, iw, 1, info )
1112 CALL chkxer( 'CHBEVD_2STAGE', infot, nout, lerr, ok )
1113 infot = 4
1114 CALL chbevd_2stage( 'N', 'U', 0, -1, a, 1, x, z, 1,
1115 $ w, 1, rw, 1, iw, 1, info )
1116 CALL chkxer( 'CHBEVD_2STAGE', infot, nout, lerr, ok )
1117 infot = 6
1118 CALL chbevd_2stage( 'N', 'U', 2, 1, a, 1, x, z, 1,
1119 $ w, 2, rw, 2, iw, 1, info )
1120 CALL chkxer( 'CHBEVD_2STAGE', infot, nout, lerr, ok )
1121 infot = 9
1122 CALL chbevd_2stage( 'N', 'U', 2, 1, a, 2, x, z, 0,
1123 $ w, 8, rw, 25, iw, 12, info )
1124 CALL chkxer( 'CHBEVD_2STAGE', infot, nout, lerr, ok )
1125 infot = 11
1126 CALL chbevd_2stage( 'N', 'U', 1, 0, a, 1, x, z, 1,
1127 $ w, 0, rw, 1, iw, 1, info )
1128 CALL chkxer( 'CHBEVD_2STAGE', infot, nout, lerr, ok )
1129 infot = 11
1130 CALL chbevd_2stage( 'N', 'U', 2, 1, a, 2, x, z, 2,
1131 $ w, 1, rw, 2, iw, 1, info )
1132 CALL chkxer( 'CHBEVD_2STAGE', infot, nout, lerr, ok )
1133* INFOT = 11
1134* CALL CHBEVD_2STAGE( 'V', 'U', 2, 1, A, 2, X, Z, 2,
1135* $ W, 2, RW, 25, IW, 12, INFO )
1136* CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
1137 infot = 13
1138 CALL chbevd_2stage( 'N', 'U', 1, 0, a, 1, x, z, 1,
1139 $ w, 1, rw, 0, iw, 1, info )
1140 CALL chkxer( 'CHBEVD_2STAGE', infot, nout, lerr, ok )
1141 infot = 13
1142 CALL chbevd_2stage( 'N', 'U', 2, 1, a, 2, x, z, 2,
1143 $ w, 25, rw, 1, iw, 1, info )
1144 CALL chkxer( 'CHBEVD_2STAGE', infot, nout, lerr, ok )
1145* INFOT = 13
1146* CALL CHBEVD_2STAGE( 'V', 'U', 2, 1, A, 2, X, Z, 2,
1147* $ W, 25, RW, 2, IW, 12, INFO )
1148* CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
1149 infot = 15
1150 CALL chbevd_2stage( 'N', 'U', 1, 0, a, 1, x, z, 1,
1151 $ w, 1, rw, 1, iw, 0, info )
1152 CALL chkxer( 'CHBEVD_2STAGE', infot, nout, lerr, ok )
1153 infot = 15
1154 CALL chbevd_2stage( 'N', 'U', 2, 1, a, 2, x, z, 2,
1155 $ w, 25, rw, 2, iw, 0, info )
1156 CALL chkxer( 'CHBEVD_2STAGE', infot, nout, lerr, ok )
1157* INFOT = 15
1158* CALL CHBEVD_2STAGE( 'V', 'U', 2, 1, A, 2, X, Z, 2,
1159* $ W, 25, RW, 25, IW, 2, INFO )
1160* CALL CHKXER( 'CHBEVD_2STAGE', INFOT, NOUT, LERR, OK )
1161 nt = nt + 13
1162*
1163* CHBEV
1164*
1165 srnamt = 'CHBEV '
1166 infot = 1
1167 CALL chbev( '/', 'U', 0, 0, a, 1, x, z, 1, w, rw, info )
1168 CALL chkxer( 'CHBEV ', infot, nout, lerr, ok )
1169 infot = 2
1170 CALL chbev( 'N', '/', 0, 0, a, 1, x, z, 1, w, rw, info )
1171 CALL chkxer( 'CHBEV ', infot, nout, lerr, ok )
1172 infot = 3
1173 CALL chbev( 'N', 'U', -1, 0, a, 1, x, z, 1, w, rw, info )
1174 CALL chkxer( 'CHBEV ', infot, nout, lerr, ok )
1175 infot = 4
1176 CALL chbev( 'N', 'U', 0, -1, a, 1, x, z, 1, w, rw, info )
1177 CALL chkxer( 'CHBEV ', infot, nout, lerr, ok )
1178 infot = 6
1179 CALL chbev( 'N', 'U', 2, 1, a, 1, x, z, 1, w, rw, info )
1180 CALL chkxer( 'CHBEV ', infot, nout, lerr, ok )
1181 infot = 9
1182 CALL chbev( 'V', 'U', 2, 0, a, 1, x, z, 1, w, rw, info )
1183 CALL chkxer( 'CHBEV ', infot, nout, lerr, ok )
1184 nt = nt + 6
1185*
1186* CHBEV_2STAGE
1187*
1188 srnamt = 'CHBEV_2STAGE '
1189 infot = 1
1190 CALL chbev_2stage( '/', 'U', 0, 0, a, 1, x,
1191 $ z, 1, w, 0, rw, info )
1192 CALL chkxer( 'CHBEV_2STAGE ', infot, nout, lerr, ok )
1193 infot = 1
1194 CALL chbev_2stage( 'V', 'U', 0, 0, a, 1, x,
1195 $ z, 1, w, 0, rw, info )
1196 CALL chkxer( 'CHBEV_2STAGE ', infot, nout, lerr, ok )
1197 infot = 2
1198 CALL chbev_2stage( 'N', '/', 0, 0, a, 1, x,
1199 $ z, 1, w, 0, rw, info )
1200 CALL chkxer( 'CHBEV_2STAGE ', infot, nout, lerr, ok )
1201 infot = 3
1202 CALL chbev_2stage( 'N', 'U', -1, 0, a, 1, x,
1203 $ z, 1, w, 0, rw, info )
1204 CALL chkxer( 'CHBEV_2STAGE ', infot, nout, lerr, ok )
1205 infot = 4
1206 CALL chbev_2stage( 'N', 'U', 0, -1, a, 1, x,
1207 $ z, 1, w, 0, rw, info )
1208 CALL chkxer( 'CHBEV_2STAGE ', infot, nout, lerr, ok )
1209 infot = 6
1210 CALL chbev_2stage( 'N', 'U', 2, 1, a, 1, x,
1211 $ z, 1, w, 0, rw, info )
1212 CALL chkxer( 'CHBEV_2STAGE ', infot, nout, lerr, ok )
1213 infot = 9
1214 CALL chbev_2stage( 'N', 'U', 2, 0, a, 1, x,
1215 $ z, 0, w, 0, rw, info )
1216 CALL chkxer( 'CHBEV_2STAGE ', infot, nout, lerr, ok )
1217 infot = 11
1218 CALL chbev_2stage( 'N', 'U', 2, 0, a, 1, x,
1219 $ z, 1, w, 0, rw, info )
1220 CALL chkxer( 'CHBEV_2STAGE ', infot, nout, lerr, ok )
1221 nt = nt + 8
1222*
1223* CHBEVX
1224*
1225 srnamt = 'CHBEVX'
1226 infot = 1
1227 CALL chbevx( '/', 'A', 'U', 0, 0, a, 1, q, 1, 0.0, 0.0, 0, 0,
1228 $ 0.0, m, x, z, 1, w, rw, iw, i3, info )
1229 CALL chkxer( 'CHBEVX', infot, nout, lerr, ok )
1230 infot = 2
1231 CALL chbevx( 'V', '/', 'U', 0, 0, a, 1, q, 1, 0.0, 1.0, 1, 0,
1232 $ 0.0, m, x, z, 1, w, rw, iw, i3, info )
1233 CALL chkxer( 'CHBEVX', infot, nout, lerr, ok )
1234 infot = 3
1235 CALL chbevx( 'V', 'A', '/', 0, 0, a, 1, q, 1, 0.0, 0.0, 0, 0,
1236 $ 0.0, m, x, z, 1, w, rw, iw, i3, info )
1237 infot = 4
1238 CALL chbevx( 'V', 'A', 'U', -1, 0, a, 1, q, 1, 0.0, 0.0, 0, 0,
1239 $ 0.0, m, x, z, 1, w, rw, iw, i3, info )
1240 CALL chkxer( 'CHBEVX', infot, nout, lerr, ok )
1241 infot = 5
1242 CALL chbevx( 'V', 'A', 'U', 0, -1, a, 1, q, 1, 0.0, 0.0, 0, 0,
1243 $ 0.0, m, x, z, 1, w, rw, iw, i3, info )
1244 CALL chkxer( 'CHBEVX', infot, nout, lerr, ok )
1245 infot = 7
1246 CALL chbevx( 'V', 'A', 'U', 2, 1, a, 1, q, 2, 0.0, 0.0, 0, 0,
1247 $ 0.0, m, x, z, 2, w, rw, iw, i3, info )
1248 CALL chkxer( 'CHBEVX', infot, nout, lerr, ok )
1249 infot = 9
1250 CALL chbevx( 'V', 'A', 'U', 2, 0, a, 1, q, 1, 0.0, 0.0, 0, 0,
1251 $ 0.0, m, x, z, 2, w, rw, iw, i3, info )
1252 CALL chkxer( 'CHBEVX', infot, nout, lerr, ok )
1253 infot = 11
1254 CALL chbevx( 'V', 'V', 'U', 1, 0, a, 1, q, 1, 0.0, 0.0, 0, 0,
1255 $ 0.0, m, x, z, 1, w, rw, iw, i3, info )
1256 CALL chkxer( 'CHBEVX', infot, nout, lerr, ok )
1257 infot = 12
1258 CALL chbevx( 'V', 'I', 'U', 1, 0, a, 1, q, 1, 0.0, 0.0, 0, 0,
1259 $ 0.0, m, x, z, 1, w, rw, iw, i3, info )
1260 CALL chkxer( 'CHBEVX', infot, nout, lerr, ok )
1261 infot = 13
1262 CALL chbevx( 'V', 'I', 'U', 1, 0, a, 1, q, 1, 0.0, 0.0, 1, 2,
1263 $ 0.0, m, x, z, 1, w, rw, iw, i3, info )
1264 CALL chkxer( 'CHBEVX', infot, nout, lerr, ok )
1265 infot = 18
1266 CALL chbevx( 'V', 'A', 'U', 2, 0, a, 1, q, 2, 0.0, 0.0, 0, 0,
1267 $ 0.0, m, x, z, 1, w, rw, iw, i3, info )
1268 CALL chkxer( 'CHBEVX', infot, nout, lerr, ok )
1269 nt = nt + 11
1270*
1271* CHBEVX_2STAGE
1272*
1273 srnamt = 'CHBEVX_2STAGE'
1274 infot = 1
1275 CALL chbevx_2stage( '/', 'A', 'U', 0, 0, a, 1, q, 1,
1276 $ 0.0, 0.0, 0, 0, 0.0,
1277 $ m, x, z, 1, w, 0, rw, iw, i3, info )
1278 infot = 1
1279 CALL chbevx_2stage( 'V', 'A', 'U', 0, 0, a, 1, q, 1,
1280 $ 0.0, 0.0, 0, 0, 0.0,
1281 $ m, x, z, 1, w, 0, rw, iw, i3, info )
1282 CALL chkxer( 'CHBEVX_2STAGE', infot, nout, lerr, ok )
1283 infot = 2
1284 CALL chbevx_2stage( 'N', '/', 'U', 0, 0, a, 1, q, 1,
1285 $ 0.0, 1.0, 1, 0, 0.0,
1286 $ m, x, z, 1, w, 0, rw, iw, i3, info )
1287 CALL chkxer( 'CHBEVX_2STAGE', infot, nout, lerr, ok )
1288 infot = 3
1289 CALL chbevx_2stage( 'N', 'A', '/', 0, 0, a, 1, q, 1,
1290 $ 0.0, 0.0, 0, 0, 0.0,
1291 $ m, x, z, 1, w, 0, rw, iw, i3, info )
1292 infot = 4
1293 CALL chbevx_2stage( 'N', 'A', 'U', -1, 0, a, 1, q, 1,
1294 $ 0.0, 0.0, 0, 0, 0.0,
1295 $ m, x, z, 1, w, 0, rw, iw, i3, info )
1296 CALL chkxer( 'CHBEVX_2STAGE', infot, nout, lerr, ok )
1297 infot = 5
1298 CALL chbevx_2stage( 'N', 'A', 'U', 0, -1, a, 1, q, 1,
1299 $ 0.0, 0.0, 0, 0, 0.0,
1300 $ m, x, z, 1, w, 0, rw, iw, i3, info )
1301 CALL chkxer( 'CHBEVX_2STAGE', infot, nout, lerr, ok )
1302 infot = 7
1303 CALL chbevx_2stage( 'N', 'A', 'U', 2, 1, a, 1, q, 2,
1304 $ 0.0, 0.0, 0, 0, 0.0,
1305 $ m, x, z, 2, w, 0, rw, iw, i3, info )
1306 CALL chkxer( 'CHBEVX_2STAGE', infot, nout, lerr, ok )
1307* INFOT = 9
1308* CALL CHBEVX_2STAGE( 'V', 'A', 'U', 2, 0, A, 1, Q, 1,
1309* $ 0.0, 0.0, 0, 0, 0.0,
1310* $ M, X, Z, 2, W, 0, RW, IW, I3, INFO )
1311* CALL CHKXER( 'CHBEVX_2STAGE', INFOT, NOUT, LERR, OK )
1312 infot = 11
1313 CALL chbevx_2stage( 'N', 'V', 'U', 1, 0, a, 1, q, 1,
1314 $ 0.0, 0.0, 0, 0, 0.0,
1315 $ m, x, z, 1, w, 0, rw, iw, i3, info )
1316 CALL chkxer( 'CHBEVX_2STAGE', infot, nout, lerr, ok )
1317 infot = 12
1318 CALL chbevx_2stage( 'N', 'I', 'U', 1, 0, a, 1, q, 1,
1319 $ 0.0, 0.0, 0, 0, 0.0,
1320 $ m, x, z, 1, w, 0, rw, iw, i3, info )
1321 CALL chkxer( 'CHBEVX_2STAGE', infot, nout, lerr, ok )
1322 infot = 13
1323 CALL chbevx_2stage( 'N', 'I', 'U', 1, 0, a, 1, q, 1,
1324 $ 0.0, 0.0, 1, 2, 0.0,
1325 $ m, x, z, 1, w, 0, rw, iw, i3, info )
1326 CALL chkxer( 'CHBEVX_2STAGE', infot, nout, lerr, ok )
1327 infot = 18
1328 CALL chbevx_2stage( 'N', 'A', 'U', 2, 0, a, 1, q, 2,
1329 $ 0.0, 0.0, 0, 0, 0.0,
1330 $ m, x, z, 0, w, 0, rw, iw, i3, info )
1331 CALL chkxer( 'CHBEVX_2STAGE', infot, nout, lerr, ok )
1332 infot = 20
1333 CALL chbevx_2stage( 'N', 'A', 'U', 2, 0, a, 1, q, 2,
1334 $ 0.0, 0.0, 0, 0, 0.0,
1335 $ m, x, z, 1, w, 0, rw, iw, i3, info )
1336 CALL chkxer( 'CHBEVX_2STAGE', infot, nout, lerr, ok )
1337 nt = nt + 12
1338 END IF
1339*
1340* Print a summary line.
1341*
1342 IF( ok ) THEN
1343 WRITE( nout, fmt = 9999 )path, nt
1344 ELSE
1345 WRITE( nout, fmt = 9998 )path
1346 END IF
1347*
1348 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits',
1349 $ ' (', i3, ' tests done)' )
1350 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
1351 $ 'exits ***' )
1352*
1353 RETURN
1354*
1355* End of CERRST
1356*
1357 END
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
subroutine cerrst(path, nunit)
CERRST
Definition cerrst.f:61
subroutine chbev_2stage(jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, rwork, info)
CHBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER m...
subroutine chbev(jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, rwork, info)
CHBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices
Definition chbev.f:152
subroutine chbevd_2stage(jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork, info)
CHBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER ...
subroutine chbevd(jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork, info)
CHBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
Definition chbevd.f:209
subroutine chbevx_2stage(jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail, info)
CHBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER ...
subroutine chbevx(jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, rwork, iwork, ifail, info)
CHBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
Definition chbevx.f:267
subroutine chbtrd(vect, uplo, n, kd, ab, ldab, d, e, q, ldq, work, info)
CHBTRD
Definition chbtrd.f:163
subroutine cheev_2stage(jobz, uplo, n, a, lda, w, work, lwork, rwork, info)
CHEEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matr...
subroutine cheev(jobz, uplo, n, a, lda, w, work, lwork, rwork, info)
CHEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices
Definition cheev.f:140
subroutine cheevd_2stage(jobz, uplo, n, a, lda, w, work, lwork, rwork, lrwork, iwork, liwork, info)
CHEEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE mat...
subroutine cheevd(jobz, uplo, n, a, lda, w, work, lwork, rwork, lrwork, iwork, liwork, info)
CHEEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices
Definition cheevd.f:199
subroutine cheevr_2stage(jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, rwork, lrwork, iwork, liwork, info)
CHEEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE mat...
subroutine cheevr(jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, rwork, lrwork, iwork, liwork, info)
CHEEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices
Definition cheevr.f:357
subroutine cheevx_2stage(jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail, info)
CHEEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE mat...
subroutine cheevx(jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail, info)
CHEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices
Definition cheevx.f:259
subroutine chetd2(uplo, n, a, lda, d, e, tau, info)
CHETD2 reduces a Hermitian matrix to real symmetric tridiagonal form by an unitary similarity transfo...
Definition chetd2.f:175
subroutine chetrd_2stage(vect, uplo, n, a, lda, d, e, tau, hous2, lhous2, work, lwork, info)
CHETRD_2STAGE
subroutine chetrd_hb2st(stage1, vect, uplo, n, kd, ab, ldab, d, e, hous, lhous, work, lwork, info)
CHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric tridiagonal form T
subroutine chetrd_he2hb(uplo, n, kd, a, lda, ab, ldab, tau, work, lwork, info)
CHETRD_HE2HB
subroutine chetrd(uplo, n, a, lda, d, e, tau, work, lwork, info)
CHETRD
Definition chetrd.f:192
subroutine chpev(jobz, uplo, n, ap, w, z, ldz, work, rwork, info)
CHPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices
Definition chpev.f:138
subroutine chpevd(jobz, uplo, n, ap, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork, info)
CHPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
Definition chpevd.f:194
subroutine chpevx(jobz, range, uplo, n, ap, vl, vu, il, iu, abstol, m, w, z, ldz, work, rwork, iwork, ifail, info)
CHPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
Definition chpevx.f:240
subroutine chptrd(uplo, n, ap, d, e, tau, info)
CHPTRD
Definition chptrd.f:151
subroutine cpteqr(compz, n, d, e, z, ldz, work, info)
CPTEQR
Definition cpteqr.f:145
subroutine cstedc(compz, n, d, e, z, ldz, work, lwork, rwork, lrwork, iwork, liwork, info)
CSTEDC
Definition cstedc.f:206
subroutine cstein(n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifail, info)
CSTEIN
Definition cstein.f:182
subroutine csteqr(compz, n, d, e, z, ldz, work, info)
CSTEQR
Definition csteqr.f:132
subroutine cungtr(uplo, n, a, lda, tau, work, lwork, info)
CUNGTR
Definition cungtr.f:123
subroutine cunmtr(side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork, info)
CUNMTR
Definition cunmtr.f:172
subroutine cupgtr(uplo, n, ap, tau, q, ldq, work, info)
CUPGTR
Definition cupgtr.f:114
subroutine cupmtr(side, uplo, trans, m, n, ap, tau, c, ldc, work, info)
CUPMTR
Definition cupmtr.f:150