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
615