1 SUBROUTINE CERRPO( PATH, NUNIT )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * CERRPO tests the error exits for the COMPLEX routines
16 * for Hermitian positive definite matrices.
17 *
18 * Arguments
19 * =========
20 *
21 * PATH (input) CHARACTER*3
22 * The LAPACK path name for the routines to be tested.
23 *
24 * NUNIT (input) INTEGER
25 * The unit number for output.
26 *
27 * =====================================================================
28 *
29 * .. Parameters ..
30 INTEGER NMAX
31 PARAMETER ( NMAX = 4 )
32 * ..
33 * .. Local Scalars ..
34 CHARACTER*2 C2
35 INTEGER I, INFO, J
36 REAL ANRM, RCOND
37 * ..
38 * .. Local Arrays ..
39 REAL R( NMAX ), R1( NMAX ), R2( NMAX )
40 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
41 $ W( 2*NMAX ), X( NMAX )
42 * ..
43 * .. External Functions ..
44 LOGICAL LSAMEN
45 EXTERNAL LSAMEN
46 * ..
47 * .. External Subroutines ..
48 EXTERNAL ALAESM, CHKXER, CPBCON, CPBEQU, CPBRFS, CPBTF2,
49 $ CPBTRF, CPBTRS, CPOCON, CPOEQU, CPORFS, CPOTF2,
50 $ CPOTRF, CPOTRI, CPOTRS, CPPCON, CPPEQU, CPPRFS,
51 $ CPPTRF, CPPTRI, CPPTRS
52 * ..
53 * .. Scalars in Common ..
54 LOGICAL LERR, OK
55 CHARACTER*32 SRNAMT
56 INTEGER INFOT, NOUT
57 * ..
58 * .. Common blocks ..
59 COMMON / INFOC / INFOT, NOUT, OK, LERR
60 COMMON / SRNAMC / SRNAMT
61 * ..
62 * .. Intrinsic Functions ..
63 INTRINSIC CMPLX, REAL
64 * ..
65 * .. Executable Statements ..
66 *
67 NOUT = NUNIT
68 WRITE( NOUT, FMT = * )
69 C2 = PATH( 2: 3 )
70 *
71 * Set the variables to innocuous values.
72 *
73 DO 20 J = 1, NMAX
74 DO 10 I = 1, NMAX
75 A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
76 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
77 10 CONTINUE
78 B( J ) = 0.
79 R1( J ) = 0.
80 R2( J ) = 0.
81 W( J ) = 0.
82 X( J ) = 0.
83 20 CONTINUE
84 ANRM = 1.
85 OK = .TRUE.
86 *
87 * Test error exits of the routines that use the Cholesky
88 * decomposition of a Hermitian positive definite matrix.
89 *
90 IF( LSAMEN( 2, C2, 'PO' ) ) THEN
91 *
92 * CPOTRF
93 *
94 SRNAMT = 'CPOTRF'
95 INFOT = 1
96 CALL CPOTRF( '/', 0, A, 1, INFO )
97 CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK )
98 INFOT = 2
99 CALL CPOTRF( 'U', -1, A, 1, INFO )
100 CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK )
101 INFOT = 4
102 CALL CPOTRF( 'U', 2, A, 1, INFO )
103 CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK )
104 *
105 * CPOTF2
106 *
107 SRNAMT = 'CPOTF2'
108 INFOT = 1
109 CALL CPOTF2( '/', 0, A, 1, INFO )
110 CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK )
111 INFOT = 2
112 CALL CPOTF2( 'U', -1, A, 1, INFO )
113 CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK )
114 INFOT = 4
115 CALL CPOTF2( 'U', 2, A, 1, INFO )
116 CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK )
117 *
118 * CPOTRI
119 *
120 SRNAMT = 'CPOTRI'
121 INFOT = 1
122 CALL CPOTRI( '/', 0, A, 1, INFO )
123 CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK )
124 INFOT = 2
125 CALL CPOTRI( 'U', -1, A, 1, INFO )
126 CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK )
127 INFOT = 4
128 CALL CPOTRI( 'U', 2, A, 1, INFO )
129 CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK )
130 *
131 * CPOTRS
132 *
133 SRNAMT = 'CPOTRS'
134 INFOT = 1
135 CALL CPOTRS( '/', 0, 0, A, 1, B, 1, INFO )
136 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
137 INFOT = 2
138 CALL CPOTRS( 'U', -1, 0, A, 1, B, 1, INFO )
139 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
140 INFOT = 3
141 CALL CPOTRS( 'U', 0, -1, A, 1, B, 1, INFO )
142 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
143 INFOT = 5
144 CALL CPOTRS( 'U', 2, 1, A, 1, B, 2, INFO )
145 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
146 INFOT = 7
147 CALL CPOTRS( 'U', 2, 1, A, 2, B, 1, INFO )
148 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
149 *
150 * CPORFS
151 *
152 SRNAMT = 'CPORFS'
153 INFOT = 1
154 CALL CPORFS( '/', 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
155 $ INFO )
156 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
157 INFOT = 2
158 CALL CPORFS( 'U', -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
159 $ INFO )
160 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
161 INFOT = 3
162 CALL CPORFS( 'U', 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
163 $ INFO )
164 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
165 INFOT = 5
166 CALL CPORFS( 'U', 2, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, R,
167 $ INFO )
168 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
169 INFOT = 7
170 CALL CPORFS( 'U', 2, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, R,
171 $ INFO )
172 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
173 INFOT = 9
174 CALL CPORFS( 'U', 2, 1, A, 2, AF, 2, B, 1, X, 2, R1, R2, W, R,
175 $ INFO )
176 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
177 INFOT = 11
178 CALL CPORFS( 'U', 2, 1, A, 2, AF, 2, B, 2, X, 1, R1, R2, W, R,
179 $ INFO )
180 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
181 *
182 * CPOCON
183 *
184 SRNAMT = 'CPOCON'
185 INFOT = 1
186 CALL CPOCON( '/', 0, A, 1, ANRM, RCOND, W, R, INFO )
187 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK )
188 INFOT = 2
189 CALL CPOCON( 'U', -1, A, 1, ANRM, RCOND, W, R, INFO )
190 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK )
191 INFOT = 4
192 CALL CPOCON( 'U', 2, A, 1, ANRM, RCOND, W, R, INFO )
193 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK )
194 INFOT = 5
195 CALL CPOCON( 'U', 1, A, 1, -ANRM, RCOND, W, R, INFO )
196 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK )
197 *
198 * CPOEQU
199 *
200 SRNAMT = 'CPOEQU'
201 INFOT = 1
202 CALL CPOEQU( -1, A, 1, R1, RCOND, ANRM, INFO )
203 CALL CHKXER( 'CPOEQU', INFOT, NOUT, LERR, OK )
204 INFOT = 3
205 CALL CPOEQU( 2, A, 1, R1, RCOND, ANRM, INFO )
206 CALL CHKXER( 'CPOEQU', INFOT, NOUT, LERR, OK )
207 *
208 * Test error exits of the routines that use the Cholesky
209 * decomposition of a Hermitian positive definite packed matrix.
210 *
211 ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN
212 *
213 * CPPTRF
214 *
215 SRNAMT = 'CPPTRF'
216 INFOT = 1
217 CALL CPPTRF( '/', 0, A, INFO )
218 CALL CHKXER( 'CPPTRF', INFOT, NOUT, LERR, OK )
219 INFOT = 2
220 CALL CPPTRF( 'U', -1, A, INFO )
221 CALL CHKXER( 'CPPTRF', INFOT, NOUT, LERR, OK )
222 *
223 * CPPTRI
224 *
225 SRNAMT = 'CPPTRI'
226 INFOT = 1
227 CALL CPPTRI( '/', 0, A, INFO )
228 CALL CHKXER( 'CPPTRI', INFOT, NOUT, LERR, OK )
229 INFOT = 2
230 CALL CPPTRI( 'U', -1, A, INFO )
231 CALL CHKXER( 'CPPTRI', INFOT, NOUT, LERR, OK )
232 *
233 * CPPTRS
234 *
235 SRNAMT = 'CPPTRS'
236 INFOT = 1
237 CALL CPPTRS( '/', 0, 0, A, B, 1, INFO )
238 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK )
239 INFOT = 2
240 CALL CPPTRS( 'U', -1, 0, A, B, 1, INFO )
241 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK )
242 INFOT = 3
243 CALL CPPTRS( 'U', 0, -1, A, B, 1, INFO )
244 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK )
245 INFOT = 6
246 CALL CPPTRS( 'U', 2, 1, A, B, 1, INFO )
247 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK )
248 *
249 * CPPRFS
250 *
251 SRNAMT = 'CPPRFS'
252 INFOT = 1
253 CALL CPPRFS( '/', 0, 0, A, AF, B, 1, X, 1, R1, R2, W, R, INFO )
254 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
255 INFOT = 2
256 CALL CPPRFS( 'U', -1, 0, A, AF, B, 1, X, 1, R1, R2, W, R,
257 $ INFO )
258 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
259 INFOT = 3
260 CALL CPPRFS( 'U', 0, -1, A, AF, B, 1, X, 1, R1, R2, W, R,
261 $ INFO )
262 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
263 INFOT = 7
264 CALL CPPRFS( 'U', 2, 1, A, AF, B, 1, X, 2, R1, R2, W, R, INFO )
265 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
266 INFOT = 9
267 CALL CPPRFS( 'U', 2, 1, A, AF, B, 2, X, 1, R1, R2, W, R, INFO )
268 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
269 *
270 * CPPCON
271 *
272 SRNAMT = 'CPPCON'
273 INFOT = 1
274 CALL CPPCON( '/', 0, A, ANRM, RCOND, W, R, INFO )
275 CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK )
276 INFOT = 2
277 CALL CPPCON( 'U', -1, A, ANRM, RCOND, W, R, INFO )
278 CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK )
279 INFOT = 4
280 CALL CPPCON( 'U', 1, A, -ANRM, RCOND, W, R, INFO )
281 CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK )
282 *
283 * CPPEQU
284 *
285 SRNAMT = 'CPPEQU'
286 INFOT = 1
287 CALL CPPEQU( '/', 0, A, R1, RCOND, ANRM, INFO )
288 CALL CHKXER( 'CPPEQU', INFOT, NOUT, LERR, OK )
289 INFOT = 2
290 CALL CPPEQU( 'U', -1, A, R1, RCOND, ANRM, INFO )
291 CALL CHKXER( 'CPPEQU', INFOT, NOUT, LERR, OK )
292 *
293 * Test error exits of the routines that use the Cholesky
294 * decomposition of a Hermitian positive definite band matrix.
295 *
296 ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN
297 *
298 * CPBTRF
299 *
300 SRNAMT = 'CPBTRF'
301 INFOT = 1
302 CALL CPBTRF( '/', 0, 0, A, 1, INFO )
303 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK )
304 INFOT = 2
305 CALL CPBTRF( 'U', -1, 0, A, 1, INFO )
306 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK )
307 INFOT = 3
308 CALL CPBTRF( 'U', 1, -1, A, 1, INFO )
309 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK )
310 INFOT = 5
311 CALL CPBTRF( 'U', 2, 1, A, 1, INFO )
312 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK )
313 *
314 * CPBTF2
315 *
316 SRNAMT = 'CPBTF2'
317 INFOT = 1
318 CALL CPBTF2( '/', 0, 0, A, 1, INFO )
319 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK )
320 INFOT = 2
321 CALL CPBTF2( 'U', -1, 0, A, 1, INFO )
322 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK )
323 INFOT = 3
324 CALL CPBTF2( 'U', 1, -1, A, 1, INFO )
325 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK )
326 INFOT = 5
327 CALL CPBTF2( 'U', 2, 1, A, 1, INFO )
328 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK )
329 *
330 * CPBTRS
331 *
332 SRNAMT = 'CPBTRS'
333 INFOT = 1
334 CALL CPBTRS( '/', 0, 0, 0, A, 1, B, 1, INFO )
335 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
336 INFOT = 2
337 CALL CPBTRS( 'U', -1, 0, 0, A, 1, B, 1, INFO )
338 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
339 INFOT = 3
340 CALL CPBTRS( 'U', 1, -1, 0, A, 1, B, 1, INFO )
341 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
342 INFOT = 4
343 CALL CPBTRS( 'U', 0, 0, -1, A, 1, B, 1, INFO )
344 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
345 INFOT = 6
346 CALL CPBTRS( 'U', 2, 1, 1, A, 1, B, 1, INFO )
347 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
348 INFOT = 8
349 CALL CPBTRS( 'U', 2, 0, 1, A, 1, B, 1, INFO )
350 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
351 *
352 * CPBRFS
353 *
354 SRNAMT = 'CPBRFS'
355 INFOT = 1
356 CALL CPBRFS( '/', 0, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
357 $ R, INFO )
358 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
359 INFOT = 2
360 CALL CPBRFS( 'U', -1, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
361 $ R, INFO )
362 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
363 INFOT = 3
364 CALL CPBRFS( 'U', 1, -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
365 $ R, INFO )
366 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
367 INFOT = 4
368 CALL CPBRFS( 'U', 0, 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
369 $ R, INFO )
370 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
371 INFOT = 6
372 CALL CPBRFS( 'U', 2, 1, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W,
373 $ R, INFO )
374 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
375 INFOT = 8
376 CALL CPBRFS( 'U', 2, 1, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W,
377 $ R, INFO )
378 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
379 INFOT = 10
380 CALL CPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 1, X, 2, R1, R2, W,
381 $ R, INFO )
382 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
383 INFOT = 12
384 CALL CPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 2, X, 1, R1, R2, W,
385 $ R, INFO )
386 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
387 *
388 * CPBCON
389 *
390 SRNAMT = 'CPBCON'
391 INFOT = 1
392 CALL CPBCON( '/', 0, 0, A, 1, ANRM, RCOND, W, R, INFO )
393 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
394 INFOT = 2
395 CALL CPBCON( 'U', -1, 0, A, 1, ANRM, RCOND, W, R, INFO )
396 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
397 INFOT = 3
398 CALL CPBCON( 'U', 1, -1, A, 1, ANRM, RCOND, W, R, INFO )
399 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
400 INFOT = 5
401 CALL CPBCON( 'U', 2, 1, A, 1, ANRM, RCOND, W, R, INFO )
402 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
403 INFOT = 6
404 CALL CPBCON( 'U', 1, 0, A, 1, -ANRM, RCOND, W, R, INFO )
405 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
406 *
407 * CPBEQU
408 *
409 SRNAMT = 'CPBEQU'
410 INFOT = 1
411 CALL CPBEQU( '/', 0, 0, A, 1, R1, RCOND, ANRM, INFO )
412 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK )
413 INFOT = 2
414 CALL CPBEQU( 'U', -1, 0, A, 1, R1, RCOND, ANRM, INFO )
415 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK )
416 INFOT = 3
417 CALL CPBEQU( 'U', 1, -1, A, 1, R1, RCOND, ANRM, INFO )
418 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK )
419 INFOT = 5
420 CALL CPBEQU( 'U', 2, 1, A, 1, R1, RCOND, ANRM, INFO )
421 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK )
422 END IF
423 *
424 * Print a summary line.
425 *
426 CALL ALAESM( PATH, OK, NOUT )
427 *
428 RETURN
429 *
430 * End of CERRPO
431 *
432 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * CERRPO tests the error exits for the COMPLEX routines
16 * for Hermitian positive definite matrices.
17 *
18 * Arguments
19 * =========
20 *
21 * PATH (input) CHARACTER*3
22 * The LAPACK path name for the routines to be tested.
23 *
24 * NUNIT (input) INTEGER
25 * The unit number for output.
26 *
27 * =====================================================================
28 *
29 * .. Parameters ..
30 INTEGER NMAX
31 PARAMETER ( NMAX = 4 )
32 * ..
33 * .. Local Scalars ..
34 CHARACTER*2 C2
35 INTEGER I, INFO, J
36 REAL ANRM, RCOND
37 * ..
38 * .. Local Arrays ..
39 REAL R( NMAX ), R1( NMAX ), R2( NMAX )
40 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
41 $ W( 2*NMAX ), X( NMAX )
42 * ..
43 * .. External Functions ..
44 LOGICAL LSAMEN
45 EXTERNAL LSAMEN
46 * ..
47 * .. External Subroutines ..
48 EXTERNAL ALAESM, CHKXER, CPBCON, CPBEQU, CPBRFS, CPBTF2,
49 $ CPBTRF, CPBTRS, CPOCON, CPOEQU, CPORFS, CPOTF2,
50 $ CPOTRF, CPOTRI, CPOTRS, CPPCON, CPPEQU, CPPRFS,
51 $ CPPTRF, CPPTRI, CPPTRS
52 * ..
53 * .. Scalars in Common ..
54 LOGICAL LERR, OK
55 CHARACTER*32 SRNAMT
56 INTEGER INFOT, NOUT
57 * ..
58 * .. Common blocks ..
59 COMMON / INFOC / INFOT, NOUT, OK, LERR
60 COMMON / SRNAMC / SRNAMT
61 * ..
62 * .. Intrinsic Functions ..
63 INTRINSIC CMPLX, REAL
64 * ..
65 * .. Executable Statements ..
66 *
67 NOUT = NUNIT
68 WRITE( NOUT, FMT = * )
69 C2 = PATH( 2: 3 )
70 *
71 * Set the variables to innocuous values.
72 *
73 DO 20 J = 1, NMAX
74 DO 10 I = 1, NMAX
75 A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
76 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
77 10 CONTINUE
78 B( J ) = 0.
79 R1( J ) = 0.
80 R2( J ) = 0.
81 W( J ) = 0.
82 X( J ) = 0.
83 20 CONTINUE
84 ANRM = 1.
85 OK = .TRUE.
86 *
87 * Test error exits of the routines that use the Cholesky
88 * decomposition of a Hermitian positive definite matrix.
89 *
90 IF( LSAMEN( 2, C2, 'PO' ) ) THEN
91 *
92 * CPOTRF
93 *
94 SRNAMT = 'CPOTRF'
95 INFOT = 1
96 CALL CPOTRF( '/', 0, A, 1, INFO )
97 CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK )
98 INFOT = 2
99 CALL CPOTRF( 'U', -1, A, 1, INFO )
100 CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK )
101 INFOT = 4
102 CALL CPOTRF( 'U', 2, A, 1, INFO )
103 CALL CHKXER( 'CPOTRF', INFOT, NOUT, LERR, OK )
104 *
105 * CPOTF2
106 *
107 SRNAMT = 'CPOTF2'
108 INFOT = 1
109 CALL CPOTF2( '/', 0, A, 1, INFO )
110 CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK )
111 INFOT = 2
112 CALL CPOTF2( 'U', -1, A, 1, INFO )
113 CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK )
114 INFOT = 4
115 CALL CPOTF2( 'U', 2, A, 1, INFO )
116 CALL CHKXER( 'CPOTF2', INFOT, NOUT, LERR, OK )
117 *
118 * CPOTRI
119 *
120 SRNAMT = 'CPOTRI'
121 INFOT = 1
122 CALL CPOTRI( '/', 0, A, 1, INFO )
123 CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK )
124 INFOT = 2
125 CALL CPOTRI( 'U', -1, A, 1, INFO )
126 CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK )
127 INFOT = 4
128 CALL CPOTRI( 'U', 2, A, 1, INFO )
129 CALL CHKXER( 'CPOTRI', INFOT, NOUT, LERR, OK )
130 *
131 * CPOTRS
132 *
133 SRNAMT = 'CPOTRS'
134 INFOT = 1
135 CALL CPOTRS( '/', 0, 0, A, 1, B, 1, INFO )
136 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
137 INFOT = 2
138 CALL CPOTRS( 'U', -1, 0, A, 1, B, 1, INFO )
139 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
140 INFOT = 3
141 CALL CPOTRS( 'U', 0, -1, A, 1, B, 1, INFO )
142 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
143 INFOT = 5
144 CALL CPOTRS( 'U', 2, 1, A, 1, B, 2, INFO )
145 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
146 INFOT = 7
147 CALL CPOTRS( 'U', 2, 1, A, 2, B, 1, INFO )
148 CALL CHKXER( 'CPOTRS', INFOT, NOUT, LERR, OK )
149 *
150 * CPORFS
151 *
152 SRNAMT = 'CPORFS'
153 INFOT = 1
154 CALL CPORFS( '/', 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
155 $ INFO )
156 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
157 INFOT = 2
158 CALL CPORFS( 'U', -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
159 $ INFO )
160 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
161 INFOT = 3
162 CALL CPORFS( 'U', 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
163 $ INFO )
164 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
165 INFOT = 5
166 CALL CPORFS( 'U', 2, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, R,
167 $ INFO )
168 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
169 INFOT = 7
170 CALL CPORFS( 'U', 2, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, R,
171 $ INFO )
172 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
173 INFOT = 9
174 CALL CPORFS( 'U', 2, 1, A, 2, AF, 2, B, 1, X, 2, R1, R2, W, R,
175 $ INFO )
176 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
177 INFOT = 11
178 CALL CPORFS( 'U', 2, 1, A, 2, AF, 2, B, 2, X, 1, R1, R2, W, R,
179 $ INFO )
180 CALL CHKXER( 'CPORFS', INFOT, NOUT, LERR, OK )
181 *
182 * CPOCON
183 *
184 SRNAMT = 'CPOCON'
185 INFOT = 1
186 CALL CPOCON( '/', 0, A, 1, ANRM, RCOND, W, R, INFO )
187 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK )
188 INFOT = 2
189 CALL CPOCON( 'U', -1, A, 1, ANRM, RCOND, W, R, INFO )
190 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK )
191 INFOT = 4
192 CALL CPOCON( 'U', 2, A, 1, ANRM, RCOND, W, R, INFO )
193 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK )
194 INFOT = 5
195 CALL CPOCON( 'U', 1, A, 1, -ANRM, RCOND, W, R, INFO )
196 CALL CHKXER( 'CPOCON', INFOT, NOUT, LERR, OK )
197 *
198 * CPOEQU
199 *
200 SRNAMT = 'CPOEQU'
201 INFOT = 1
202 CALL CPOEQU( -1, A, 1, R1, RCOND, ANRM, INFO )
203 CALL CHKXER( 'CPOEQU', INFOT, NOUT, LERR, OK )
204 INFOT = 3
205 CALL CPOEQU( 2, A, 1, R1, RCOND, ANRM, INFO )
206 CALL CHKXER( 'CPOEQU', INFOT, NOUT, LERR, OK )
207 *
208 * Test error exits of the routines that use the Cholesky
209 * decomposition of a Hermitian positive definite packed matrix.
210 *
211 ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN
212 *
213 * CPPTRF
214 *
215 SRNAMT = 'CPPTRF'
216 INFOT = 1
217 CALL CPPTRF( '/', 0, A, INFO )
218 CALL CHKXER( 'CPPTRF', INFOT, NOUT, LERR, OK )
219 INFOT = 2
220 CALL CPPTRF( 'U', -1, A, INFO )
221 CALL CHKXER( 'CPPTRF', INFOT, NOUT, LERR, OK )
222 *
223 * CPPTRI
224 *
225 SRNAMT = 'CPPTRI'
226 INFOT = 1
227 CALL CPPTRI( '/', 0, A, INFO )
228 CALL CHKXER( 'CPPTRI', INFOT, NOUT, LERR, OK )
229 INFOT = 2
230 CALL CPPTRI( 'U', -1, A, INFO )
231 CALL CHKXER( 'CPPTRI', INFOT, NOUT, LERR, OK )
232 *
233 * CPPTRS
234 *
235 SRNAMT = 'CPPTRS'
236 INFOT = 1
237 CALL CPPTRS( '/', 0, 0, A, B, 1, INFO )
238 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK )
239 INFOT = 2
240 CALL CPPTRS( 'U', -1, 0, A, B, 1, INFO )
241 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK )
242 INFOT = 3
243 CALL CPPTRS( 'U', 0, -1, A, B, 1, INFO )
244 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK )
245 INFOT = 6
246 CALL CPPTRS( 'U', 2, 1, A, B, 1, INFO )
247 CALL CHKXER( 'CPPTRS', INFOT, NOUT, LERR, OK )
248 *
249 * CPPRFS
250 *
251 SRNAMT = 'CPPRFS'
252 INFOT = 1
253 CALL CPPRFS( '/', 0, 0, A, AF, B, 1, X, 1, R1, R2, W, R, INFO )
254 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
255 INFOT = 2
256 CALL CPPRFS( 'U', -1, 0, A, AF, B, 1, X, 1, R1, R2, W, R,
257 $ INFO )
258 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
259 INFOT = 3
260 CALL CPPRFS( 'U', 0, -1, A, AF, B, 1, X, 1, R1, R2, W, R,
261 $ INFO )
262 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
263 INFOT = 7
264 CALL CPPRFS( 'U', 2, 1, A, AF, B, 1, X, 2, R1, R2, W, R, INFO )
265 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
266 INFOT = 9
267 CALL CPPRFS( 'U', 2, 1, A, AF, B, 2, X, 1, R1, R2, W, R, INFO )
268 CALL CHKXER( 'CPPRFS', INFOT, NOUT, LERR, OK )
269 *
270 * CPPCON
271 *
272 SRNAMT = 'CPPCON'
273 INFOT = 1
274 CALL CPPCON( '/', 0, A, ANRM, RCOND, W, R, INFO )
275 CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK )
276 INFOT = 2
277 CALL CPPCON( 'U', -1, A, ANRM, RCOND, W, R, INFO )
278 CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK )
279 INFOT = 4
280 CALL CPPCON( 'U', 1, A, -ANRM, RCOND, W, R, INFO )
281 CALL CHKXER( 'CPPCON', INFOT, NOUT, LERR, OK )
282 *
283 * CPPEQU
284 *
285 SRNAMT = 'CPPEQU'
286 INFOT = 1
287 CALL CPPEQU( '/', 0, A, R1, RCOND, ANRM, INFO )
288 CALL CHKXER( 'CPPEQU', INFOT, NOUT, LERR, OK )
289 INFOT = 2
290 CALL CPPEQU( 'U', -1, A, R1, RCOND, ANRM, INFO )
291 CALL CHKXER( 'CPPEQU', INFOT, NOUT, LERR, OK )
292 *
293 * Test error exits of the routines that use the Cholesky
294 * decomposition of a Hermitian positive definite band matrix.
295 *
296 ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN
297 *
298 * CPBTRF
299 *
300 SRNAMT = 'CPBTRF'
301 INFOT = 1
302 CALL CPBTRF( '/', 0, 0, A, 1, INFO )
303 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK )
304 INFOT = 2
305 CALL CPBTRF( 'U', -1, 0, A, 1, INFO )
306 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK )
307 INFOT = 3
308 CALL CPBTRF( 'U', 1, -1, A, 1, INFO )
309 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK )
310 INFOT = 5
311 CALL CPBTRF( 'U', 2, 1, A, 1, INFO )
312 CALL CHKXER( 'CPBTRF', INFOT, NOUT, LERR, OK )
313 *
314 * CPBTF2
315 *
316 SRNAMT = 'CPBTF2'
317 INFOT = 1
318 CALL CPBTF2( '/', 0, 0, A, 1, INFO )
319 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK )
320 INFOT = 2
321 CALL CPBTF2( 'U', -1, 0, A, 1, INFO )
322 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK )
323 INFOT = 3
324 CALL CPBTF2( 'U', 1, -1, A, 1, INFO )
325 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK )
326 INFOT = 5
327 CALL CPBTF2( 'U', 2, 1, A, 1, INFO )
328 CALL CHKXER( 'CPBTF2', INFOT, NOUT, LERR, OK )
329 *
330 * CPBTRS
331 *
332 SRNAMT = 'CPBTRS'
333 INFOT = 1
334 CALL CPBTRS( '/', 0, 0, 0, A, 1, B, 1, INFO )
335 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
336 INFOT = 2
337 CALL CPBTRS( 'U', -1, 0, 0, A, 1, B, 1, INFO )
338 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
339 INFOT = 3
340 CALL CPBTRS( 'U', 1, -1, 0, A, 1, B, 1, INFO )
341 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
342 INFOT = 4
343 CALL CPBTRS( 'U', 0, 0, -1, A, 1, B, 1, INFO )
344 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
345 INFOT = 6
346 CALL CPBTRS( 'U', 2, 1, 1, A, 1, B, 1, INFO )
347 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
348 INFOT = 8
349 CALL CPBTRS( 'U', 2, 0, 1, A, 1, B, 1, INFO )
350 CALL CHKXER( 'CPBTRS', INFOT, NOUT, LERR, OK )
351 *
352 * CPBRFS
353 *
354 SRNAMT = 'CPBRFS'
355 INFOT = 1
356 CALL CPBRFS( '/', 0, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
357 $ R, INFO )
358 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
359 INFOT = 2
360 CALL CPBRFS( 'U', -1, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
361 $ R, INFO )
362 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
363 INFOT = 3
364 CALL CPBRFS( 'U', 1, -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
365 $ R, INFO )
366 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
367 INFOT = 4
368 CALL CPBRFS( 'U', 0, 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
369 $ R, INFO )
370 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
371 INFOT = 6
372 CALL CPBRFS( 'U', 2, 1, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W,
373 $ R, INFO )
374 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
375 INFOT = 8
376 CALL CPBRFS( 'U', 2, 1, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W,
377 $ R, INFO )
378 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
379 INFOT = 10
380 CALL CPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 1, X, 2, R1, R2, W,
381 $ R, INFO )
382 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
383 INFOT = 12
384 CALL CPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 2, X, 1, R1, R2, W,
385 $ R, INFO )
386 CALL CHKXER( 'CPBRFS', INFOT, NOUT, LERR, OK )
387 *
388 * CPBCON
389 *
390 SRNAMT = 'CPBCON'
391 INFOT = 1
392 CALL CPBCON( '/', 0, 0, A, 1, ANRM, RCOND, W, R, INFO )
393 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
394 INFOT = 2
395 CALL CPBCON( 'U', -1, 0, A, 1, ANRM, RCOND, W, R, INFO )
396 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
397 INFOT = 3
398 CALL CPBCON( 'U', 1, -1, A, 1, ANRM, RCOND, W, R, INFO )
399 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
400 INFOT = 5
401 CALL CPBCON( 'U', 2, 1, A, 1, ANRM, RCOND, W, R, INFO )
402 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
403 INFOT = 6
404 CALL CPBCON( 'U', 1, 0, A, 1, -ANRM, RCOND, W, R, INFO )
405 CALL CHKXER( 'CPBCON', INFOT, NOUT, LERR, OK )
406 *
407 * CPBEQU
408 *
409 SRNAMT = 'CPBEQU'
410 INFOT = 1
411 CALL CPBEQU( '/', 0, 0, A, 1, R1, RCOND, ANRM, INFO )
412 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK )
413 INFOT = 2
414 CALL CPBEQU( 'U', -1, 0, A, 1, R1, RCOND, ANRM, INFO )
415 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK )
416 INFOT = 3
417 CALL CPBEQU( 'U', 1, -1, A, 1, R1, RCOND, ANRM, INFO )
418 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK )
419 INFOT = 5
420 CALL CPBEQU( 'U', 2, 1, A, 1, R1, RCOND, ANRM, INFO )
421 CALL CHKXER( 'CPBEQU', INFOT, NOUT, LERR, OK )
422 END IF
423 *
424 * Print a summary line.
425 *
426 CALL ALAESM( PATH, OK, NOUT )
427 *
428 RETURN
429 *
430 * End of CERRPO
431 *
432 END