1 SUBROUTINE CERRHE( PATH, NUNIT )
2 *
3 * -- LAPACK test routine (version 3.3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * -- April 2011 --
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * CERRHE tests the error exits for the COMPLEX routines
16 * for Hermitian indefinite matrices.
17 *
18 * Note that this file is used only when the XBLAS are available,
19 * otherwise cerrhe.f defines this subroutine.
20 *
21 * Arguments
22 * =========
23 *
24 * PATH (input) CHARACTER*3
25 * The LAPACK path name for the routines to be tested.
26 *
27 * NUNIT (input) INTEGER
28 * The unit number for output.
29 *
30 * =====================================================================
31 *
32 *
33 * .. Parameters ..
34 INTEGER NMAX
35 PARAMETER ( NMAX = 4 )
36 * ..
37 * .. Local Scalars ..
38 CHARACTER EQ
39 CHARACTER*2 C2
40 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
41 REAL ANRM, RCOND, BERR
42 * ..
43 * .. Local Arrays ..
44 INTEGER IP( NMAX )
45 REAL R( NMAX ), R1( NMAX ), R2( NMAX ),
46 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
47 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
48 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
49 $ W( 2*NMAX ), X( NMAX )
50 * ..
51 * .. External Functions ..
52 LOGICAL LSAMEN
53 EXTERNAL LSAMEN
54 * ..
55 * .. External Subroutines ..
56 EXTERNAL ALAESM, CHECON, CHERFS, CHETF2, CHETRF, CHETRI,
57 $ CHETRI2, CHETRS, CHKXER, CHPCON, CHPRFS,
58 $ CHPTRF, CHPTRI, CHPTRS, CHERFSX
59 * ..
60 * .. Scalars in Common ..
61 LOGICAL LERR, OK
62 CHARACTER*32 SRNAMT
63 INTEGER INFOT, NOUT
64 * ..
65 * .. Common blocks ..
66 COMMON / INFOC / INFOT, NOUT, OK, LERR
67 COMMON / SRNAMC / SRNAMT
68 * ..
69 * .. Intrinsic Functions ..
70 INTRINSIC CMPLX, REAL
71 * ..
72 * .. Executable Statements ..
73 *
74 NOUT = NUNIT
75 WRITE( NOUT, FMT = * )
76 C2 = PATH( 2: 3 )
77 *
78 * Set the variables to innocuous values.
79 *
80 DO 20 J = 1, NMAX
81 DO 10 I = 1, NMAX
82 A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
83 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
84 10 CONTINUE
85 B( J ) = 0.
86 R1( J ) = 0.
87 R2( J ) = 0.
88 W( J ) = 0.
89 X( J ) = 0.
90 S( J ) = 0.
91 IP( J ) = J
92 20 CONTINUE
93 ANRM = 1.0
94 OK = .TRUE.
95 *
96 * Test error exits of the routines that use the diagonal pivoting
97 * factorization of a Hermitian indefinite matrix.
98 *
99 IF( LSAMEN( 2, C2, 'HE' ) ) THEN
100 *
101 * CHETRF
102 *
103 SRNAMT = 'CHETRF'
104 INFOT = 1
105 CALL CHETRF( '/', 0, A, 1, IP, W, 1, INFO )
106 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
107 INFOT = 2
108 CALL CHETRF( 'U', -1, A, 1, IP, W, 1, INFO )
109 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
110 INFOT = 4
111 CALL CHETRF( 'U', 2, A, 1, IP, W, 4, INFO )
112 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
113 *
114 * CHETF2
115 *
116 SRNAMT = 'CHETF2'
117 INFOT = 1
118 CALL CHETF2( '/', 0, A, 1, IP, INFO )
119 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK )
120 INFOT = 2
121 CALL CHETF2( 'U', -1, A, 1, IP, INFO )
122 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK )
123 INFOT = 4
124 CALL CHETF2( 'U', 2, A, 1, IP, INFO )
125 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK )
126 *
127 * CHETRI
128 *
129 SRNAMT = 'CHETRI'
130 INFOT = 1
131 CALL CHETRI( '/', 0, A, 1, IP, W, INFO )
132 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK )
133 INFOT = 2
134 CALL CHETRI( 'U', -1, A, 1, IP, W, INFO )
135 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK )
136 INFOT = 4
137 CALL CHETRI( 'U', 2, A, 1, IP, W, INFO )
138 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK )
139 *
140 * CHETRI2
141 *
142 SRNAMT = 'CHETRI2'
143 INFOT = 1
144 CALL CHETRI2( '/', 0, A, 1, IP, W, 1, INFO )
145 CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK )
146 INFOT = 2
147 CALL CHETRI2( 'U', -1, A, 1, IP, W, 1, INFO )
148 CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK )
149 INFOT = 4
150 CALL CHETRI2( 'U', 2, A, 1, IP, W, 1, INFO )
151 CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK )
152 *
153 * CHETRS
154 *
155 SRNAMT = 'CHETRS'
156 INFOT = 1
157 CALL CHETRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
158 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
159 INFOT = 2
160 CALL CHETRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
161 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
162 INFOT = 3
163 CALL CHETRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
164 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
165 INFOT = 5
166 CALL CHETRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
167 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
168 INFOT = 8
169 CALL CHETRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
170 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
171 *
172 * CHERFS
173 *
174 SRNAMT = 'CHERFS'
175 INFOT = 1
176 CALL CHERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
177 $ R, INFO )
178 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
179 INFOT = 2
180 CALL CHERFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
181 $ W, R, INFO )
182 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
183 INFOT = 3
184 CALL CHERFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
185 $ W, R, INFO )
186 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
187 INFOT = 5
188 CALL CHERFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
189 $ R, INFO )
190 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
191 INFOT = 7
192 CALL CHERFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
193 $ R, INFO )
194 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
195 INFOT = 10
196 CALL CHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
197 $ R, INFO )
198 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
199 INFOT = 12
200 CALL CHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
201 $ R, INFO )
202 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
203 *
204 * CHECON
205 *
206 SRNAMT = 'CHECON'
207 INFOT = 1
208 CALL CHECON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
209 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
210 INFOT = 2
211 CALL CHECON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
212 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
213 INFOT = 4
214 CALL CHECON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
215 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
216 INFOT = 6
217 CALL CHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
218 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
219 *
220 * Test error exits of the routines that use the diagonal pivoting
221 * factorization of a Hermitian indefinite packed matrix.
222 *
223 ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
224 *
225 * CHPTRF
226 *
227 SRNAMT = 'CHPTRF'
228 INFOT = 1
229 CALL CHPTRF( '/', 0, A, IP, INFO )
230 CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK )
231 INFOT = 2
232 CALL CHPTRF( 'U', -1, A, IP, INFO )
233 CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK )
234 *
235 * CHPTRI
236 *
237 SRNAMT = 'CHPTRI'
238 INFOT = 1
239 CALL CHPTRI( '/', 0, A, IP, W, INFO )
240 CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK )
241 INFOT = 2
242 CALL CHPTRI( 'U', -1, A, IP, W, INFO )
243 CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK )
244 *
245 * CHPTRS
246 *
247 SRNAMT = 'CHPTRS'
248 INFOT = 1
249 CALL CHPTRS( '/', 0, 0, A, IP, B, 1, INFO )
250 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
251 INFOT = 2
252 CALL CHPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
253 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
254 INFOT = 3
255 CALL CHPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
256 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
257 INFOT = 7
258 CALL CHPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
259 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
260 *
261 * CHPRFS
262 *
263 SRNAMT = 'CHPRFS'
264 INFOT = 1
265 CALL CHPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
266 $ INFO )
267 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
268 INFOT = 2
269 CALL CHPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
270 $ INFO )
271 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
272 INFOT = 3
273 CALL CHPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
274 $ INFO )
275 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
276 INFOT = 8
277 CALL CHPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
278 $ INFO )
279 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
280 INFOT = 10
281 CALL CHPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
282 $ INFO )
283 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
284 *
285 * CHERFSX
286 *
287 N_ERR_BNDS = 3
288 NPARAMS = 0
289 SRNAMT = 'CHERFSX'
290 INFOT = 1
291 CALL CHERFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
292 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
293 $ PARAMS, W, R, INFO )
294 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
295 INFOT = 2
296 CALL CHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
297 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
298 $ PARAMS, W, R, INFO )
299 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
300 EQ = 'N'
301 INFOT = 3
302 CALL CHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
303 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
304 $ PARAMS, W, R, INFO )
305 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
306 INFOT = 4
307 CALL CHERFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1,
308 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
309 $ PARAMS, W, R, INFO )
310 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
311 INFOT = 6
312 CALL CHERFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2,
313 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
314 $ PARAMS, W, R, INFO )
315 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
316 INFOT = 8
317 CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2,
318 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
319 $ PARAMS, W, R, INFO )
320 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
321 INFOT = 11
322 CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2,
323 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
324 $ PARAMS, W, R, INFO )
325 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
326 INFOT = 13
327 CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1,
328 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
329 $ PARAMS, W, R, INFO )
330 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
331 *
332 * CHPCON
333 *
334 SRNAMT = 'CHPCON'
335 INFOT = 1
336 CALL CHPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO )
337 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK )
338 INFOT = 2
339 CALL CHPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO )
340 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK )
341 INFOT = 5
342 CALL CHPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
343 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK )
344 END IF
345 *
346 * Print a summary line.
347 *
348 CALL ALAESM( PATH, OK, NOUT )
349 *
350 RETURN
351 *
352 * End of CERRHE
353 *
354 END
2 *
3 * -- LAPACK test routine (version 3.3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * -- April 2011 --
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * CERRHE tests the error exits for the COMPLEX routines
16 * for Hermitian indefinite matrices.
17 *
18 * Note that this file is used only when the XBLAS are available,
19 * otherwise cerrhe.f defines this subroutine.
20 *
21 * Arguments
22 * =========
23 *
24 * PATH (input) CHARACTER*3
25 * The LAPACK path name for the routines to be tested.
26 *
27 * NUNIT (input) INTEGER
28 * The unit number for output.
29 *
30 * =====================================================================
31 *
32 *
33 * .. Parameters ..
34 INTEGER NMAX
35 PARAMETER ( NMAX = 4 )
36 * ..
37 * .. Local Scalars ..
38 CHARACTER EQ
39 CHARACTER*2 C2
40 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
41 REAL ANRM, RCOND, BERR
42 * ..
43 * .. Local Arrays ..
44 INTEGER IP( NMAX )
45 REAL R( NMAX ), R1( NMAX ), R2( NMAX ),
46 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
47 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
48 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
49 $ W( 2*NMAX ), X( NMAX )
50 * ..
51 * .. External Functions ..
52 LOGICAL LSAMEN
53 EXTERNAL LSAMEN
54 * ..
55 * .. External Subroutines ..
56 EXTERNAL ALAESM, CHECON, CHERFS, CHETF2, CHETRF, CHETRI,
57 $ CHETRI2, CHETRS, CHKXER, CHPCON, CHPRFS,
58 $ CHPTRF, CHPTRI, CHPTRS, CHERFSX
59 * ..
60 * .. Scalars in Common ..
61 LOGICAL LERR, OK
62 CHARACTER*32 SRNAMT
63 INTEGER INFOT, NOUT
64 * ..
65 * .. Common blocks ..
66 COMMON / INFOC / INFOT, NOUT, OK, LERR
67 COMMON / SRNAMC / SRNAMT
68 * ..
69 * .. Intrinsic Functions ..
70 INTRINSIC CMPLX, REAL
71 * ..
72 * .. Executable Statements ..
73 *
74 NOUT = NUNIT
75 WRITE( NOUT, FMT = * )
76 C2 = PATH( 2: 3 )
77 *
78 * Set the variables to innocuous values.
79 *
80 DO 20 J = 1, NMAX
81 DO 10 I = 1, NMAX
82 A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
83 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
84 10 CONTINUE
85 B( J ) = 0.
86 R1( J ) = 0.
87 R2( J ) = 0.
88 W( J ) = 0.
89 X( J ) = 0.
90 S( J ) = 0.
91 IP( J ) = J
92 20 CONTINUE
93 ANRM = 1.0
94 OK = .TRUE.
95 *
96 * Test error exits of the routines that use the diagonal pivoting
97 * factorization of a Hermitian indefinite matrix.
98 *
99 IF( LSAMEN( 2, C2, 'HE' ) ) THEN
100 *
101 * CHETRF
102 *
103 SRNAMT = 'CHETRF'
104 INFOT = 1
105 CALL CHETRF( '/', 0, A, 1, IP, W, 1, INFO )
106 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
107 INFOT = 2
108 CALL CHETRF( 'U', -1, A, 1, IP, W, 1, INFO )
109 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
110 INFOT = 4
111 CALL CHETRF( 'U', 2, A, 1, IP, W, 4, INFO )
112 CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
113 *
114 * CHETF2
115 *
116 SRNAMT = 'CHETF2'
117 INFOT = 1
118 CALL CHETF2( '/', 0, A, 1, IP, INFO )
119 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK )
120 INFOT = 2
121 CALL CHETF2( 'U', -1, A, 1, IP, INFO )
122 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK )
123 INFOT = 4
124 CALL CHETF2( 'U', 2, A, 1, IP, INFO )
125 CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK )
126 *
127 * CHETRI
128 *
129 SRNAMT = 'CHETRI'
130 INFOT = 1
131 CALL CHETRI( '/', 0, A, 1, IP, W, INFO )
132 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK )
133 INFOT = 2
134 CALL CHETRI( 'U', -1, A, 1, IP, W, INFO )
135 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK )
136 INFOT = 4
137 CALL CHETRI( 'U', 2, A, 1, IP, W, INFO )
138 CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK )
139 *
140 * CHETRI2
141 *
142 SRNAMT = 'CHETRI2'
143 INFOT = 1
144 CALL CHETRI2( '/', 0, A, 1, IP, W, 1, INFO )
145 CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK )
146 INFOT = 2
147 CALL CHETRI2( 'U', -1, A, 1, IP, W, 1, INFO )
148 CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK )
149 INFOT = 4
150 CALL CHETRI2( 'U', 2, A, 1, IP, W, 1, INFO )
151 CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK )
152 *
153 * CHETRS
154 *
155 SRNAMT = 'CHETRS'
156 INFOT = 1
157 CALL CHETRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
158 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
159 INFOT = 2
160 CALL CHETRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
161 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
162 INFOT = 3
163 CALL CHETRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
164 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
165 INFOT = 5
166 CALL CHETRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
167 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
168 INFOT = 8
169 CALL CHETRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
170 CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
171 *
172 * CHERFS
173 *
174 SRNAMT = 'CHERFS'
175 INFOT = 1
176 CALL CHERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
177 $ R, INFO )
178 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
179 INFOT = 2
180 CALL CHERFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
181 $ W, R, INFO )
182 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
183 INFOT = 3
184 CALL CHERFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
185 $ W, R, INFO )
186 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
187 INFOT = 5
188 CALL CHERFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
189 $ R, INFO )
190 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
191 INFOT = 7
192 CALL CHERFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
193 $ R, INFO )
194 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
195 INFOT = 10
196 CALL CHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
197 $ R, INFO )
198 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
199 INFOT = 12
200 CALL CHERFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
201 $ R, INFO )
202 CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
203 *
204 * CHECON
205 *
206 SRNAMT = 'CHECON'
207 INFOT = 1
208 CALL CHECON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
209 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
210 INFOT = 2
211 CALL CHECON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
212 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
213 INFOT = 4
214 CALL CHECON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
215 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
216 INFOT = 6
217 CALL CHECON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
218 CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
219 *
220 * Test error exits of the routines that use the diagonal pivoting
221 * factorization of a Hermitian indefinite packed matrix.
222 *
223 ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
224 *
225 * CHPTRF
226 *
227 SRNAMT = 'CHPTRF'
228 INFOT = 1
229 CALL CHPTRF( '/', 0, A, IP, INFO )
230 CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK )
231 INFOT = 2
232 CALL CHPTRF( 'U', -1, A, IP, INFO )
233 CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK )
234 *
235 * CHPTRI
236 *
237 SRNAMT = 'CHPTRI'
238 INFOT = 1
239 CALL CHPTRI( '/', 0, A, IP, W, INFO )
240 CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK )
241 INFOT = 2
242 CALL CHPTRI( 'U', -1, A, IP, W, INFO )
243 CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK )
244 *
245 * CHPTRS
246 *
247 SRNAMT = 'CHPTRS'
248 INFOT = 1
249 CALL CHPTRS( '/', 0, 0, A, IP, B, 1, INFO )
250 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
251 INFOT = 2
252 CALL CHPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
253 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
254 INFOT = 3
255 CALL CHPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
256 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
257 INFOT = 7
258 CALL CHPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
259 CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
260 *
261 * CHPRFS
262 *
263 SRNAMT = 'CHPRFS'
264 INFOT = 1
265 CALL CHPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
266 $ INFO )
267 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
268 INFOT = 2
269 CALL CHPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
270 $ INFO )
271 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
272 INFOT = 3
273 CALL CHPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
274 $ INFO )
275 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
276 INFOT = 8
277 CALL CHPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
278 $ INFO )
279 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
280 INFOT = 10
281 CALL CHPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
282 $ INFO )
283 CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
284 *
285 * CHERFSX
286 *
287 N_ERR_BNDS = 3
288 NPARAMS = 0
289 SRNAMT = 'CHERFSX'
290 INFOT = 1
291 CALL CHERFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
292 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
293 $ PARAMS, W, R, INFO )
294 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
295 INFOT = 2
296 CALL CHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
297 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
298 $ PARAMS, W, R, INFO )
299 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
300 EQ = 'N'
301 INFOT = 3
302 CALL CHERFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
303 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
304 $ PARAMS, W, R, INFO )
305 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
306 INFOT = 4
307 CALL CHERFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1,
308 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
309 $ PARAMS, W, R, INFO )
310 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
311 INFOT = 6
312 CALL CHERFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2,
313 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
314 $ PARAMS, W, R, INFO )
315 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
316 INFOT = 8
317 CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2,
318 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
319 $ PARAMS, W, R, INFO )
320 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
321 INFOT = 11
322 CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2,
323 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
324 $ PARAMS, W, R, INFO )
325 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
326 INFOT = 13
327 CALL CHERFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1,
328 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
329 $ PARAMS, W, R, INFO )
330 CALL CHKXER( 'CHERFSX', INFOT, NOUT, LERR, OK )
331 *
332 * CHPCON
333 *
334 SRNAMT = 'CHPCON'
335 INFOT = 1
336 CALL CHPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO )
337 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK )
338 INFOT = 2
339 CALL CHPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO )
340 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK )
341 INFOT = 5
342 CALL CHPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
343 CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK )
344 END IF
345 *
346 * Print a summary line.
347 *
348 CALL ALAESM( PATH, OK, NOUT )
349 *
350 RETURN
351 *
352 * End of CERRHE
353 *
354 END