LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
cerrhe.f
Go to the documentation of this file.
1 *> \brief \b CERRHE
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 CERRHE( 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 *> CERRHE tests the error exits for the COMPLEX routines
25 *> for Hermitian indefinite matrices.
26 *> \endverbatim
27 *
28 * Arguments:
29 * ==========
30 *
31 *> \param[in] PATH
32 *> \verbatim
33 *> PATH is CHARACTER*3
34 *> The LAPACK path name for the routines to be tested.
35 *> \endverbatim
36 *>
37 *> \param[in] NUNIT
38 *> \verbatim
39 *> NUNIT is INTEGER
40 *> The unit number for output.
41 *> \endverbatim
42 *
43 * Authors:
44 * ========
45 *
46 *> \author Univ. of Tennessee
47 *> \author Univ. of California Berkeley
48 *> \author Univ. of Colorado Denver
49 *> \author NAG Ltd.
50 *
51 *> \ingroup complex_lin
52 *
53 * =====================================================================
54  SUBROUTINE cerrhe( PATH, NUNIT )
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 *
68 * .. Parameters ..
69  INTEGER NMAX
70  parameter( nmax = 4 )
71 * ..
72 * .. Local Scalars ..
73  CHARACTER*2 C2
74  INTEGER I, INFO, J
75  REAL ANRM, RCOND
76 * ..
77 * .. Local Arrays ..
78  INTEGER IP( NMAX )
79  REAL R( NMAX ), R1( NMAX ), R2( NMAX )
80  COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
81  $ E( NMAX ), W( 2*NMAX ), X( NMAX )
82 * ..
83 * .. External Functions ..
84  LOGICAL LSAMEN
85  EXTERNAL lsamen
86 * ..
87 * .. External Subroutines ..
88  EXTERNAL alaesm, checon, csycon_3, checon_rook, cherfs,
89  $ chetf2, chetf2_rk, chetf2_rook, chetrf_aa,
90  $ chetrf, chetrf_rk, chetrf_rook, chetri,
91  $ chetri_3, chetri_3x, chetri_rook, chetri2,
92  $ chetri2x, chetrs, chetrs_3, chetrs_rook,
93  $ chetrs_aa, chkxer, chpcon, chprfs, chptrf,
94  $ chetrf_aa_2stage, chetrs_aa_2stage,
95  $ chptri, chptrs
96 * ..
97 * .. Scalars in Common ..
98  LOGICAL LERR, OK
99  CHARACTER*32 SRNAMT
100  INTEGER INFOT, NOUT
101 * ..
102 * .. Common blocks ..
103  COMMON / infoc / infot, nout, ok, lerr
104  COMMON / srnamc / srnamt
105 * ..
106 * .. Intrinsic Functions ..
107  INTRINSIC cmplx, real
108 * ..
109 * .. Executable Statements ..
110 *
111  nout = nunit
112  WRITE( nout, fmt = * )
113  c2 = path( 2: 3 )
114 *
115 * Set the variables to innocuous values.
116 *
117  DO 20 j = 1, nmax
118  DO 10 i = 1, nmax
119  a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
120  af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
121  10 CONTINUE
122  b( j ) = 0.e+0
123  e( j ) = 0.e+0
124  r1( j ) = 0.e+0
125  r2( j ) = 0.e+0
126  w( j ) = 0.e+0
127  x( j ) = 0.e+0
128  ip( j ) = j
129  20 CONTINUE
130  anrm = 1.0
131  ok = .true.
132 *
133  IF( lsamen( 2, c2, 'HE' ) ) THEN
134 *
135 * Test error exits of the routines that use factorization
136 * of a Hermitian indefinite matrix with patrial
137 * (Bunch-Kaufman) diagonal pivoting method.
138 *
139 * CHETRF
140 *
141  srnamt = 'CHETRF'
142  infot = 1
143  CALL chetrf( '/', 0, a, 1, ip, w, 1, info )
144  CALL chkxer( 'CHETRF', infot, nout, lerr, ok )
145  infot = 2
146  CALL chetrf( 'U', -1, a, 1, ip, w, 1, info )
147  CALL chkxer( 'CHETRF', infot, nout, lerr, ok )
148  infot = 4
149  CALL chetrf( 'U', 2, a, 1, ip, w, 4, info )
150  CALL chkxer( 'CHETRF', infot, nout, lerr, ok )
151  infot = 7
152  CALL chetrf( 'U', 0, a, 1, ip, w, 0, info )
153  CALL chkxer( 'CHETRF', infot, nout, lerr, ok )
154  infot = 7
155  CALL chetrf( 'U', 0, a, 1, ip, w, -2, info )
156  CALL chkxer( 'CHETRF', infot, nout, lerr, ok )
157 *
158 * CHETF2
159 *
160  srnamt = 'CHETF2'
161  infot = 1
162  CALL chetf2( '/', 0, a, 1, ip, info )
163  CALL chkxer( 'CHETF2', infot, nout, lerr, ok )
164  infot = 2
165  CALL chetf2( 'U', -1, a, 1, ip, info )
166  CALL chkxer( 'CHETF2', infot, nout, lerr, ok )
167  infot = 4
168  CALL chetf2( 'U', 2, a, 1, ip, info )
169  CALL chkxer( 'CHETF2', infot, nout, lerr, ok )
170 *
171 * CHETRI
172 *
173  srnamt = 'CHETRI'
174  infot = 1
175  CALL chetri( '/', 0, a, 1, ip, w, info )
176  CALL chkxer( 'CHETRI', infot, nout, lerr, ok )
177  infot = 2
178  CALL chetri( 'U', -1, a, 1, ip, w, info )
179  CALL chkxer( 'CHETRI', infot, nout, lerr, ok )
180  infot = 4
181  CALL chetri( 'U', 2, a, 1, ip, w, info )
182  CALL chkxer( 'CHETRI', infot, nout, lerr, ok )
183 *
184 * CHETRI2
185 *
186  srnamt = 'CHETRI2'
187  infot = 1
188  CALL chetri2( '/', 0, a, 1, ip, w, 1, info )
189  CALL chkxer( 'CHETRI2', infot, nout, lerr, ok )
190  infot = 2
191  CALL chetri2( 'U', -1, a, 1, ip, w, 1, info )
192  CALL chkxer( 'CHETRI2', infot, nout, lerr, ok )
193  infot = 4
194  CALL chetri2( 'U', 2, a, 1, ip, w, 1, info )
195  CALL chkxer( 'CHETRI2', infot, nout, lerr, ok )
196 *
197 * CHETRI2X
198 *
199  srnamt = 'CHETRI2X'
200  infot = 1
201  CALL chetri2x( '/', 0, a, 1, ip, w, 1, info )
202  CALL chkxer( 'CHETRI2X', infot, nout, lerr, ok )
203  infot = 2
204  CALL chetri2x( 'U', -1, a, 1, ip, w, 1, info )
205  CALL chkxer( 'CHETRI2X', infot, nout, lerr, ok )
206  infot = 4
207  CALL chetri2x( 'U', 2, a, 1, ip, w, 1, info )
208  CALL chkxer( 'CHETRI2X', infot, nout, lerr, ok )
209 *
210 * CHETRS
211 *
212  srnamt = 'CHETRS'
213  infot = 1
214  CALL chetrs( '/', 0, 0, a, 1, ip, b, 1, info )
215  CALL chkxer( 'CHETRS', infot, nout, lerr, ok )
216  infot = 2
217  CALL chetrs( 'U', -1, 0, a, 1, ip, b, 1, info )
218  CALL chkxer( 'CHETRS', infot, nout, lerr, ok )
219  infot = 3
220  CALL chetrs( 'U', 0, -1, a, 1, ip, b, 1, info )
221  CALL chkxer( 'CHETRS', infot, nout, lerr, ok )
222  infot = 5
223  CALL chetrs( 'U', 2, 1, a, 1, ip, b, 2, info )
224  CALL chkxer( 'CHETRS', infot, nout, lerr, ok )
225  infot = 8
226  CALL chetrs( 'U', 2, 1, a, 2, ip, b, 1, info )
227  CALL chkxer( 'CHETRS', infot, nout, lerr, ok )
228 *
229 * CHERFS
230 *
231  srnamt = 'CHERFS'
232  infot = 1
233  CALL cherfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
234  $ r, info )
235  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
236  infot = 2
237  CALL cherfs( 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
238  $ w, r, info )
239  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
240  infot = 3
241  CALL cherfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
242  $ w, r, info )
243  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
244  infot = 5
245  CALL cherfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
246  $ r, info )
247  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
248  infot = 7
249  CALL cherfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
250  $ r, info )
251  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
252  infot = 10
253  CALL cherfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
254  $ r, info )
255  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
256  infot = 12
257  CALL cherfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
258  $ r, info )
259  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
260 *
261 * CHECON
262 *
263  srnamt = 'CHECON'
264  infot = 1
265  CALL checon( '/', 0, a, 1, ip, anrm, rcond, w, info )
266  CALL chkxer( 'CHECON', infot, nout, lerr, ok )
267  infot = 2
268  CALL checon( 'U', -1, a, 1, ip, anrm, rcond, w, info )
269  CALL chkxer( 'CHECON', infot, nout, lerr, ok )
270  infot = 4
271  CALL checon( 'U', 2, a, 1, ip, anrm, rcond, w, info )
272  CALL chkxer( 'CHECON', infot, nout, lerr, ok )
273  infot = 6
274  CALL checon( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
275  CALL chkxer( 'CHECON', infot, nout, lerr, ok )
276 *
277  ELSE IF( lsamen( 2, c2, 'HR' ) ) THEN
278 *
279 * Test error exits of the routines that use factorization
280 * of a Hermitian indefinite matrix with rook
281 * (bounded Bunch-Kaufman) diagonal pivoting method.
282 *
283 * CHETRF_ROOK
284 *
285  srnamt = 'CHETRF_ROOK'
286  infot = 1
287  CALL chetrf_rook( '/', 0, a, 1, ip, w, 1, info )
288  CALL chkxer( 'CHETRF_ROOK', infot, nout, lerr, ok )
289  infot = 2
290  CALL chetrf_rook( 'U', -1, a, 1, ip, w, 1, info )
291  CALL chkxer( 'CHETRF_ROOK', infot, nout, lerr, ok )
292  infot = 4
293  CALL chetrf_rook( 'U', 2, a, 1, ip, w, 4, info )
294  CALL chkxer( 'CHETRF_ROOK', infot, nout, lerr, ok )
295  infot = 7
296  CALL chetrf_rook( 'U', 0, a, 1, ip, w, 0, info )
297  CALL chkxer( 'CHETRF_ROOK', infot, nout, lerr, ok )
298  infot = 7
299  CALL chetrf_rook( 'U', 0, a, 1, ip, w, -2, info )
300  CALL chkxer( 'CHETRF_ROOK', infot, nout, lerr, ok )
301 *
302 * CHETF2_ROOK
303 *
304  srnamt = 'CHETF2_ROOK'
305  infot = 1
306  CALL chetf2_rook( '/', 0, a, 1, ip, info )
307  CALL chkxer( 'CHETF2_ROOK', infot, nout, lerr, ok )
308  infot = 2
309  CALL chetf2_rook( 'U', -1, a, 1, ip, info )
310  CALL chkxer( 'CHETF2_ROOK', infot, nout, lerr, ok )
311  infot = 4
312  CALL chetf2_rook( 'U', 2, a, 1, ip, info )
313  CALL chkxer( 'CHETF2_ROOK', infot, nout, lerr, ok )
314 *
315 * CHETRI_ROOK
316 *
317  srnamt = 'CHETRI_ROOK'
318  infot = 1
319  CALL chetri_rook( '/', 0, a, 1, ip, w, info )
320  CALL chkxer( 'CHETRI_ROOK', infot, nout, lerr, ok )
321  infot = 2
322  CALL chetri_rook( 'U', -1, a, 1, ip, w, info )
323  CALL chkxer( 'CHETRI_ROOK', infot, nout, lerr, ok )
324  infot = 4
325  CALL chetri_rook( 'U', 2, a, 1, ip, w, info )
326  CALL chkxer( 'CHETRI_ROOK', infot, nout, lerr, ok )
327 *
328 * CHETRS_ROOK
329 *
330  srnamt = 'CHETRS_ROOK'
331  infot = 1
332  CALL chetrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
333  CALL chkxer( 'CHETRS_ROOK', infot, nout, lerr, ok )
334  infot = 2
335  CALL chetrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
336  CALL chkxer( 'CHETRS_ROOK', infot, nout, lerr, ok )
337  infot = 3
338  CALL chetrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
339  CALL chkxer( 'CHETRS_ROOK', infot, nout, lerr, ok )
340  infot = 5
341  CALL chetrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
342  CALL chkxer( 'CHETRS_ROOK', infot, nout, lerr, ok )
343  infot = 8
344  CALL chetrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
345  CALL chkxer( 'CHETRS_ROOK', infot, nout, lerr, ok )
346 *
347 * CHECON_ROOK
348 *
349  srnamt = 'CHECON_ROOK'
350  infot = 1
351  CALL checon_rook( '/', 0, a, 1, ip, anrm, rcond, w, info )
352  CALL chkxer( 'CHECON_ROOK', infot, nout, lerr, ok )
353  infot = 2
354  CALL checon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, info )
355  CALL chkxer( 'CHECON_ROOK', infot, nout, lerr, ok )
356  infot = 4
357  CALL checon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, info )
358  CALL chkxer( 'CHECON_ROOK', infot, nout, lerr, ok )
359  infot = 6
360  CALL checon_rook( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
361  CALL chkxer( 'CHECON_ROOK', infot, nout, lerr, ok )
362 *
363  ELSE IF( lsamen( 2, c2, 'HK' ) ) THEN
364 *
365 * Test error exits of the routines that use factorization
366 * of a Hermitian indefinite matrix with rook
367 * (bounded Bunch-Kaufman) pivoting with the new storage
368 * format for factors L ( or U) and D.
369 *
370 * L (or U) is stored in A, diagonal of D is stored on the
371 * diagonal of A, subdiagonal of D is stored in a separate array E.
372 *
373 * CHETRF_RK
374 *
375  srnamt = 'CHETRF_RK'
376  infot = 1
377  CALL chetrf_rk( '/', 0, a, 1, e, ip, w, 1, info )
378  CALL chkxer( 'CHETRF_RK', infot, nout, lerr, ok )
379  infot = 2
380  CALL chetrf_rk( 'U', -1, a, 1, e, ip, w, 1, info )
381  CALL chkxer( 'CHETRF_RK', infot, nout, lerr, ok )
382  infot = 4
383  CALL chetrf_rk( 'U', 2, a, 1, e, ip, w, 4, info )
384  CALL chkxer( 'CHETRF_RK', infot, nout, lerr, ok )
385  infot = 8
386  CALL chetrf_rk( 'U', 0, a, 1, e, ip, w, 0, info )
387  CALL chkxer( 'CHETRF_RK', infot, nout, lerr, ok )
388  infot = 8
389  CALL chetrf_rk( 'U', 0, a, 1, e, ip, w, -2, info )
390  CALL chkxer( 'CHETRF_RK', infot, nout, lerr, ok )
391 *
392 * CHETF2_RK
393 *
394  srnamt = 'CHETF2_RK'
395  infot = 1
396  CALL chetf2_rk( '/', 0, a, 1, e, ip, info )
397  CALL chkxer( 'CHETF2_RK', infot, nout, lerr, ok )
398  infot = 2
399  CALL chetf2_rk( 'U', -1, a, 1, e, ip, info )
400  CALL chkxer( 'CHETF2_RK', infot, nout, lerr, ok )
401  infot = 4
402  CALL chetf2_rk( 'U', 2, a, 1, e, ip, info )
403  CALL chkxer( 'CHETF2_RK', infot, nout, lerr, ok )
404 *
405 * CHETRI_3
406 *
407  srnamt = 'CHETRI_3'
408  infot = 1
409  CALL chetri_3( '/', 0, a, 1, e, ip, w, 1, info )
410  CALL chkxer( 'CHETRI_3', infot, nout, lerr, ok )
411  infot = 2
412  CALL chetri_3( 'U', -1, a, 1, e, ip, w, 1, info )
413  CALL chkxer( 'CHETRI_3', infot, nout, lerr, ok )
414  infot = 4
415  CALL chetri_3( 'U', 2, a, 1, e, ip, w, 1, info )
416  CALL chkxer( 'CHETRI_3', infot, nout, lerr, ok )
417  infot = 8
418  CALL chetri_3( 'U', 0, a, 1, e, ip, w, 0, info )
419  CALL chkxer( 'CHETRI_3', infot, nout, lerr, ok )
420  infot = 8
421  CALL chetri_3( 'U', 0, a, 1, e, ip, w, -2, info )
422  CALL chkxer( 'CHETRI_3', infot, nout, lerr, ok )
423 *
424 * CHETRI_3X
425 *
426  srnamt = 'CHETRI_3X'
427  infot = 1
428  CALL chetri_3x( '/', 0, a, 1, e, ip, w, 1, info )
429  CALL chkxer( 'CHETRI_3X', infot, nout, lerr, ok )
430  infot = 2
431  CALL chetri_3x( 'U', -1, a, 1, e, ip, w, 1, info )
432  CALL chkxer( 'CHETRI_3X', infot, nout, lerr, ok )
433  infot = 4
434  CALL chetri_3x( 'U', 2, a, 1, e, ip, w, 1, info )
435  CALL chkxer( 'CHETRI_3X', infot, nout, lerr, ok )
436 *
437 * CHETRS_3
438 *
439  srnamt = 'CHETRS_3'
440  infot = 1
441  CALL chetrs_3( '/', 0, 0, a, 1, e, ip, b, 1, info )
442  CALL chkxer( 'CHETRS_3', infot, nout, lerr, ok )
443  infot = 2
444  CALL chetrs_3( 'U', -1, 0, a, 1, e, ip, b, 1, info )
445  CALL chkxer( 'CHETRS_3', infot, nout, lerr, ok )
446  infot = 3
447  CALL chetrs_3( 'U', 0, -1, a, 1, e, ip, b, 1, info )
448  CALL chkxer( 'CHETRS_3', infot, nout, lerr, ok )
449  infot = 5
450  CALL chetrs_3( 'U', 2, 1, a, 1, e, ip, b, 2, info )
451  CALL chkxer( 'CHETRS_3', infot, nout, lerr, ok )
452  infot = 9
453  CALL chetrs_3( 'U', 2, 1, a, 2, e, ip, b, 1, info )
454  CALL chkxer( 'CHETRS_3', infot, nout, lerr, ok )
455 *
456 * CHECON_3
457 *
458  srnamt = 'CHECON_3'
459  infot = 1
460  CALL checon_3( '/', 0, a, 1, e, ip, anrm, rcond, w, info )
461  CALL chkxer( 'CHECON_3', infot, nout, lerr, ok )
462  infot = 2
463  CALL checon_3( 'U', -1, a, 1, e, ip, anrm, rcond, w, info )
464  CALL chkxer( 'CHECON_3', infot, nout, lerr, ok )
465  infot = 4
466  CALL checon_3( 'U', 2, a, 1, e, ip, anrm, rcond, w, info )
467  CALL chkxer( 'CHECON_3', infot, nout, lerr, ok )
468  infot = 7
469  CALL checon_3( 'U', 1, a, 1, e, ip, -1.0e0, rcond, w, info)
470  CALL chkxer( 'CHECON_3', infot, nout, lerr, ok )
471 *
472  ELSE IF( lsamen( 2, c2, 'HA' ) ) THEN
473 *
474 * Test error exits of the routines that use factorization
475 * of a Hermitian indefinite matrix with Aasen's algorithm.
476 *
477 * CHETRF_AA
478 *
479  srnamt = 'CHETRF_AA'
480  infot = 1
481  CALL chetrf_aa( '/', 0, a, 1, ip, w, 1, info )
482  CALL chkxer( 'CHETRF_AA', infot, nout, lerr, ok )
483  infot = 2
484  CALL chetrf_aa( 'U', -1, a, 1, ip, w, 1, info )
485  CALL chkxer( 'CHETRF_AA', infot, nout, lerr, ok )
486  infot = 4
487  CALL chetrf_aa( 'U', 2, a, 1, ip, w, 4, info )
488  CALL chkxer( 'CHETRF_AA', infot, nout, lerr, ok )
489  infot = 7
490  CALL chetrf_aa( 'U', 2, a, 2, ip, w, 0, info )
491  CALL chkxer( 'CHETRF_AA', infot, nout, lerr, ok )
492  infot = 7
493  CALL chetrf_aa( 'U', 2, a, 2, ip, w, -2, info )
494  CALL chkxer( 'CHETRF_AA', infot, nout, lerr, ok )
495 *
496 * CHETRS_AA
497 *
498  srnamt = 'CHETRS_AA'
499  infot = 1
500  CALL chetrs_aa( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
501  CALL chkxer( 'CHETRS_AA', infot, nout, lerr, ok )
502  infot = 2
503  CALL chetrs_aa( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
504  CALL chkxer( 'CHETRS_AA', infot, nout, lerr, ok )
505  infot = 3
506  CALL chetrs_aa( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
507  CALL chkxer( 'CHETRS_AA', infot, nout, lerr, ok )
508  infot = 5
509  CALL chetrs_aa( 'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
510  CALL chkxer( 'CHETRS_AA', infot, nout, lerr, ok )
511  infot = 8
512  CALL chetrs_aa( 'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
513  CALL chkxer( 'CHETRS_AA', infot, nout, lerr, ok )
514  infot = 10
515  CALL chetrs_aa( 'U', 2, 1, a, 2, ip, b, 2, w, 0, info )
516  CALL chkxer( 'CHETRS_AA', infot, nout, lerr, ok )
517  infot = 10
518  CALL chetrs_aa( 'U', 2, 1, a, 2, ip, b, 2, w, -2, info )
519  CALL chkxer( 'CHETRS_AA', infot, nout, lerr, ok )
520 *
521  ELSE IF( lsamen( 2, c2, 'H2' ) ) THEN
522 *
523 * Test error exits of the routines that use factorization
524 * of a symmetric indefinite matrix with Aasen's algorithm.
525 *
526 * CHETRF_AA_2STAGE
527 *
528  srnamt = 'CHETRF_AA_2STAGE'
529  infot = 1
530  CALL chetrf_aa_2stage( '/', 0, a, 1, a, 1, ip, ip, w, 1,
531  $ info )
532  CALL chkxer( 'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
533  infot = 2
534  CALL chetrf_aa_2stage( 'U', -1, a, 1, a, 1, ip, ip, w, 1,
535  $ info )
536  CALL chkxer( 'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
537  infot = 4
538  CALL chetrf_aa_2stage( 'U', 2, a, 1, a, 2, ip, ip, w, 1,
539  $ info )
540  CALL chkxer( 'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
541  infot = 6
542  CALL chetrf_aa_2stage( 'U', 2, a, 2, a, 1, ip, ip, w, 1,
543  $ info )
544  CALL chkxer( 'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
545  infot = 10
546  CALL chetrf_aa_2stage( 'U', 2, a, 2, a, 8, ip, ip, w, 0,
547  $ info )
548  CALL chkxer( 'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
549 *
550 * CHETRS_AA_2STAGE
551 *
552  srnamt = 'CHETRS_AA_2STAGE'
553  infot = 1
554  CALL chetrs_aa_2stage( '/', 0, 0, a, 1, a, 1, ip, ip,
555  $ b, 1, info )
556  CALL chkxer( 'CHETRS_AA_2STAGE', infot, nout, lerr, ok )
557  infot = 2
558  CALL chetrs_aa_2stage( 'U', -1, 0, a, 1, a, 1, ip, ip,
559  $ b, 1, info )
560  CALL chkxer( 'CHETRS_AA_2STAGE', infot, nout, lerr, ok )
561  infot = 3
562  CALL chetrs_aa_2stage( 'U', 0, -1, a, 1, a, 1, ip, ip,
563  $ b, 1, info )
564  CALL chkxer( 'CHETRS_AA_2STAGE', infot, nout, lerr, ok )
565  infot = 5
566  CALL chetrs_aa_2stage( 'U', 2, 1, a, 1, a, 1, ip, ip,
567  $ b, 1, info )
568  CALL chkxer( 'CHETRS_AA_2STAGE', infot, nout, lerr, ok )
569  infot = 7
570  CALL chetrs_aa_2stage( 'U', 2, 1, a, 2, a, 1, ip, ip,
571  $ b, 1, info )
572  CALL chkxer( 'CHETRS_AA_2STAGE', infot, nout, lerr, ok )
573  infot = 11
574  CALL chetrs_aa_2stage( 'U', 2, 1, a, 2, a, 8, ip, ip,
575  $ b, 1, info )
576  CALL chkxer( 'CHETRS_AA_STAGE', infot, nout, lerr, ok )
577 *
578 * Test error exits of the routines that use factorization
579 * of a Hermitian indefinite packed matrix with patrial
580 * (Bunch-Kaufman) diagonal pivoting method.
581 *
582  ELSE IF( lsamen( 2, c2, 'HP' ) ) THEN
583 *
584 * CHPTRF
585 *
586  srnamt = 'CHPTRF'
587  infot = 1
588  CALL chptrf( '/', 0, a, ip, info )
589  CALL chkxer( 'CHPTRF', infot, nout, lerr, ok )
590  infot = 2
591  CALL chptrf( 'U', -1, a, ip, info )
592  CALL chkxer( 'CHPTRF', infot, nout, lerr, ok )
593 *
594 * CHPTRI
595 *
596  srnamt = 'CHPTRI'
597  infot = 1
598  CALL chptri( '/', 0, a, ip, w, info )
599  CALL chkxer( 'CHPTRI', infot, nout, lerr, ok )
600  infot = 2
601  CALL chptri( 'U', -1, a, ip, w, info )
602  CALL chkxer( 'CHPTRI', infot, nout, lerr, ok )
603 *
604 * CHPTRS
605 *
606  srnamt = 'CHPTRS'
607  infot = 1
608  CALL chptrs( '/', 0, 0, a, ip, b, 1, info )
609  CALL chkxer( 'CHPTRS', infot, nout, lerr, ok )
610  infot = 2
611  CALL chptrs( 'U', -1, 0, a, ip, b, 1, info )
612  CALL chkxer( 'CHPTRS', infot, nout, lerr, ok )
613  infot = 3
614  CALL chptrs( 'U', 0, -1, a, ip, b, 1, info )
615  CALL chkxer( 'CHPTRS', infot, nout, lerr, ok )
616  infot = 7
617  CALL chptrs( 'U', 2, 1, a, ip, b, 1, info )
618  CALL chkxer( 'CHPTRS', infot, nout, lerr, ok )
619 *
620 * CHPRFS
621 *
622  srnamt = 'CHPRFS'
623  infot = 1
624  CALL chprfs( '/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
625  $ info )
626  CALL chkxer( 'CHPRFS', infot, nout, lerr, ok )
627  infot = 2
628  CALL chprfs( 'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
629  $ info )
630  CALL chkxer( 'CHPRFS', infot, nout, lerr, ok )
631  infot = 3
632  CALL chprfs( 'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
633  $ info )
634  CALL chkxer( 'CHPRFS', infot, nout, lerr, ok )
635  infot = 8
636  CALL chprfs( 'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
637  $ info )
638  CALL chkxer( 'CHPRFS', infot, nout, lerr, ok )
639  infot = 10
640  CALL chprfs( 'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
641  $ info )
642  CALL chkxer( 'CHPRFS', infot, nout, lerr, ok )
643 *
644 * CHPCON
645 *
646  srnamt = 'CHPCON'
647  infot = 1
648  CALL chpcon( '/', 0, a, ip, anrm, rcond, w, info )
649  CALL chkxer( 'CHPCON', infot, nout, lerr, ok )
650  infot = 2
651  CALL chpcon( 'U', -1, a, ip, anrm, rcond, w, info )
652  CALL chkxer( 'CHPCON', infot, nout, lerr, ok )
653  infot = 5
654  CALL chpcon( 'U', 1, a, ip, -anrm, rcond, w, info )
655  CALL chkxer( 'CHPCON', infot, nout, lerr, ok )
656  END IF
657 *
658 * Print a summary line.
659 *
660  CALL alaesm( path, ok, nout )
661 *
662  RETURN
663 *
664 * End of CERRHE
665 *
666  END
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
cerrhe
subroutine cerrhe(PATH, NUNIT)
CERRHE
Definition: cerrhe.f:55
chetf2_rook
subroutine chetf2_rook(UPLO, N, A, LDA, IPIV, INFO)
CHETF2_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
Definition: chetf2_rook.f:194
chetrf
subroutine chetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF
Definition: chetrf.f:177
checon_rook
subroutine checon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obt...
Definition: checon_rook.f:139
cherfs
subroutine cherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHERFS
Definition: cherfs.f:192
chetri_3x
subroutine chetri_3x(UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO)
CHETRI_3X
Definition: chetri_3x.f:159
chetrs_rook
subroutine chetrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using fac...
Definition: chetrs_rook.f:136
chetri_3
subroutine chetri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CHETRI_3
Definition: chetri_3.f:170
chetf2
subroutine chetf2(UPLO, N, A, LDA, IPIV, INFO)
CHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (...
Definition: chetf2.f:186
chetrf_rook
subroutine chetrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
Definition: chetrf_rook.f:212
chetri2
subroutine chetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRI2
Definition: chetri2.f:127
chetrf_aa
subroutine chetrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_AA
Definition: chetrf_aa.f:132
chetrf_rk
subroutine chetrf_rk(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CHETRF_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch...
Definition: chetrf_rk.f:259
checon_3
subroutine checon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, INFO)
CHECON_3
Definition: checon_3.f:166
checon
subroutine checon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CHECON
Definition: checon.f:125
chetrs
subroutine chetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS
Definition: chetrs.f:120
chetf2_rk
subroutine chetf2_rk(UPLO, N, A, LDA, E, IPIV, INFO)
CHETF2_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch...
Definition: chetf2_rk.f:241
chetrs_aa
subroutine chetrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CHETRS_AA
Definition: chetrs_aa.f:131
chetri_rook
subroutine chetri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch...
Definition: chetri_rook.f:128
chetri
subroutine chetri(UPLO, N, A, LDA, IPIV, WORK, INFO)
CHETRI
Definition: chetri.f:114
chetrs_3
subroutine chetrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
CHETRS_3
Definition: chetrs_3.f:165
chetri2x
subroutine chetri2x(UPLO, N, A, LDA, IPIV, WORK, NB, INFO)
CHETRI2X
Definition: chetri2x.f:120
chptrs
subroutine chptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CHPTRS
Definition: chptrs.f:115
chptrf
subroutine chptrf(UPLO, N, AP, IPIV, INFO)
CHPTRF
Definition: chptrf.f:159
chpcon
subroutine chpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
CHPCON
Definition: chpcon.f:118
chprfs
subroutine chprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHPRFS
Definition: chprfs.f:180
chptri
subroutine chptri(UPLO, N, AP, IPIV, WORK, INFO)
CHPTRI
Definition: chptri.f:109
csycon_3
subroutine csycon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON_3
Definition: csycon_3.f:166
chetrf_aa_2stage
subroutine chetrf_aa_2stage(UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, WORK, LWORK, INFO)
CHETRF_AA_2STAGE
Definition: chetrf_aa_2stage.f:160
chetrs_aa_2stage
subroutine chetrs_aa_2stage(UPLO, N, NRHS, A, LDA, TB, LTB, IPIV, IPIV2, B, LDB, INFO)
CHETRS_AA_2STAGE
Definition: chetrs_aa_2stage.f:141