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