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