1 SUBROUTINE ZERRPO( 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 * ZERRPO tests the error exits for the COMPLEX*16 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 DOUBLE PRECISION ANRM, RCOND
37 * ..
38 * .. Local Arrays ..
39 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX )
40 COMPLEX*16 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, ZPBCON, ZPBEQU, ZPBRFS, ZPBTF2,
49 $ ZPBTRF, ZPBTRS, ZPOCON, ZPOEQU, ZPORFS, ZPOTF2,
50 $ ZPOTRF, ZPOTRI, ZPOTRS, ZPPCON, ZPPEQU, ZPPRFS,
51 $ ZPPTRF, ZPPTRI, ZPPTRS
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 DBLE, DCMPLX
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 ) = DCMPLX( 1.D0 / DBLE( I+J ),
76 $ -1.D0 / DBLE( I+J ) )
77 AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ),
78 $ -1.D0 / DBLE( I+J ) )
79 10 CONTINUE
80 B( J ) = 0.D0
81 R1( J ) = 0.D0
82 R2( J ) = 0.D0
83 W( J ) = 0.D0
84 X( J ) = 0.D0
85 20 CONTINUE
86 ANRM = 1.D0
87 OK = .TRUE.
88 *
89 * Test error exits of the routines that use the Cholesky
90 * decomposition of a Hermitian positive definite matrix.
91 *
92 IF( LSAMEN( 2, C2, 'PO' ) ) THEN
93 *
94 * ZPOTRF
95 *
96 SRNAMT = 'ZPOTRF'
97 INFOT = 1
98 CALL ZPOTRF( '/', 0, A, 1, INFO )
99 CALL CHKXER( 'ZPOTRF', INFOT, NOUT, LERR, OK )
100 INFOT = 2
101 CALL ZPOTRF( 'U', -1, A, 1, INFO )
102 CALL CHKXER( 'ZPOTRF', INFOT, NOUT, LERR, OK )
103 INFOT = 4
104 CALL ZPOTRF( 'U', 2, A, 1, INFO )
105 CALL CHKXER( 'ZPOTRF', INFOT, NOUT, LERR, OK )
106 *
107 * ZPOTF2
108 *
109 SRNAMT = 'ZPOTF2'
110 INFOT = 1
111 CALL ZPOTF2( '/', 0, A, 1, INFO )
112 CALL CHKXER( 'ZPOTF2', INFOT, NOUT, LERR, OK )
113 INFOT = 2
114 CALL ZPOTF2( 'U', -1, A, 1, INFO )
115 CALL CHKXER( 'ZPOTF2', INFOT, NOUT, LERR, OK )
116 INFOT = 4
117 CALL ZPOTF2( 'U', 2, A, 1, INFO )
118 CALL CHKXER( 'ZPOTF2', INFOT, NOUT, LERR, OK )
119 *
120 * ZPOTRI
121 *
122 SRNAMT = 'ZPOTRI'
123 INFOT = 1
124 CALL ZPOTRI( '/', 0, A, 1, INFO )
125 CALL CHKXER( 'ZPOTRI', INFOT, NOUT, LERR, OK )
126 INFOT = 2
127 CALL ZPOTRI( 'U', -1, A, 1, INFO )
128 CALL CHKXER( 'ZPOTRI', INFOT, NOUT, LERR, OK )
129 INFOT = 4
130 CALL ZPOTRI( 'U', 2, A, 1, INFO )
131 CALL CHKXER( 'ZPOTRI', INFOT, NOUT, LERR, OK )
132 *
133 * ZPOTRS
134 *
135 SRNAMT = 'ZPOTRS'
136 INFOT = 1
137 CALL ZPOTRS( '/', 0, 0, A, 1, B, 1, INFO )
138 CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
139 INFOT = 2
140 CALL ZPOTRS( 'U', -1, 0, A, 1, B, 1, INFO )
141 CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
142 INFOT = 3
143 CALL ZPOTRS( 'U', 0, -1, A, 1, B, 1, INFO )
144 CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
145 INFOT = 5
146 CALL ZPOTRS( 'U', 2, 1, A, 1, B, 2, INFO )
147 CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
148 INFOT = 7
149 CALL ZPOTRS( 'U', 2, 1, A, 2, B, 1, INFO )
150 CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
151 *
152 * ZPORFS
153 *
154 SRNAMT = 'ZPORFS'
155 INFOT = 1
156 CALL ZPORFS( '/', 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
157 $ INFO )
158 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
159 INFOT = 2
160 CALL ZPORFS( 'U', -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
161 $ INFO )
162 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
163 INFOT = 3
164 CALL ZPORFS( 'U', 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
165 $ INFO )
166 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
167 INFOT = 5
168 CALL ZPORFS( 'U', 2, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, R,
169 $ INFO )
170 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
171 INFOT = 7
172 CALL ZPORFS( 'U', 2, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, R,
173 $ INFO )
174 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
175 INFOT = 9
176 CALL ZPORFS( 'U', 2, 1, A, 2, AF, 2, B, 1, X, 2, R1, R2, W, R,
177 $ INFO )
178 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
179 INFOT = 11
180 CALL ZPORFS( 'U', 2, 1, A, 2, AF, 2, B, 2, X, 1, R1, R2, W, R,
181 $ INFO )
182 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
183 *
184 * ZPOCON
185 *
186 SRNAMT = 'ZPOCON'
187 INFOT = 1
188 CALL ZPOCON( '/', 0, A, 1, ANRM, RCOND, W, R, INFO )
189 CALL CHKXER( 'ZPOCON', INFOT, NOUT, LERR, OK )
190 INFOT = 2
191 CALL ZPOCON( 'U', -1, A, 1, ANRM, RCOND, W, R, INFO )
192 CALL CHKXER( 'ZPOCON', INFOT, NOUT, LERR, OK )
193 INFOT = 4
194 CALL ZPOCON( 'U', 2, A, 1, ANRM, RCOND, W, R, INFO )
195 CALL CHKXER( 'ZPOCON', INFOT, NOUT, LERR, OK )
196 INFOT = 5
197 CALL ZPOCON( 'U', 1, A, 1, -ANRM, RCOND, W, R, INFO )
198 CALL CHKXER( 'ZPOCON', INFOT, NOUT, LERR, OK )
199 *
200 * ZPOEQU
201 *
202 SRNAMT = 'ZPOEQU'
203 INFOT = 1
204 CALL ZPOEQU( -1, A, 1, R1, RCOND, ANRM, INFO )
205 CALL CHKXER( 'ZPOEQU', INFOT, NOUT, LERR, OK )
206 INFOT = 3
207 CALL ZPOEQU( 2, A, 1, R1, RCOND, ANRM, INFO )
208 CALL CHKXER( 'ZPOEQU', INFOT, NOUT, LERR, OK )
209 *
210 * Test error exits of the routines that use the Cholesky
211 * decomposition of a Hermitian positive definite packed matrix.
212 *
213 ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN
214 *
215 * ZPPTRF
216 *
217 SRNAMT = 'ZPPTRF'
218 INFOT = 1
219 CALL ZPPTRF( '/', 0, A, INFO )
220 CALL CHKXER( 'ZPPTRF', INFOT, NOUT, LERR, OK )
221 INFOT = 2
222 CALL ZPPTRF( 'U', -1, A, INFO )
223 CALL CHKXER( 'ZPPTRF', INFOT, NOUT, LERR, OK )
224 *
225 * ZPPTRI
226 *
227 SRNAMT = 'ZPPTRI'
228 INFOT = 1
229 CALL ZPPTRI( '/', 0, A, INFO )
230 CALL CHKXER( 'ZPPTRI', INFOT, NOUT, LERR, OK )
231 INFOT = 2
232 CALL ZPPTRI( 'U', -1, A, INFO )
233 CALL CHKXER( 'ZPPTRI', INFOT, NOUT, LERR, OK )
234 *
235 * ZPPTRS
236 *
237 SRNAMT = 'ZPPTRS'
238 INFOT = 1
239 CALL ZPPTRS( '/', 0, 0, A, B, 1, INFO )
240 CALL CHKXER( 'ZPPTRS', INFOT, NOUT, LERR, OK )
241 INFOT = 2
242 CALL ZPPTRS( 'U', -1, 0, A, B, 1, INFO )
243 CALL CHKXER( 'ZPPTRS', INFOT, NOUT, LERR, OK )
244 INFOT = 3
245 CALL ZPPTRS( 'U', 0, -1, A, B, 1, INFO )
246 CALL CHKXER( 'ZPPTRS', INFOT, NOUT, LERR, OK )
247 INFOT = 6
248 CALL ZPPTRS( 'U', 2, 1, A, B, 1, INFO )
249 CALL CHKXER( 'ZPPTRS', INFOT, NOUT, LERR, OK )
250 *
251 * ZPPRFS
252 *
253 SRNAMT = 'ZPPRFS'
254 INFOT = 1
255 CALL ZPPRFS( '/', 0, 0, A, AF, B, 1, X, 1, R1, R2, W, R, INFO )
256 CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
257 INFOT = 2
258 CALL ZPPRFS( 'U', -1, 0, A, AF, B, 1, X, 1, R1, R2, W, R,
259 $ INFO )
260 CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
261 INFOT = 3
262 CALL ZPPRFS( 'U', 0, -1, A, AF, B, 1, X, 1, R1, R2, W, R,
263 $ INFO )
264 CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
265 INFOT = 7
266 CALL ZPPRFS( 'U', 2, 1, A, AF, B, 1, X, 2, R1, R2, W, R, INFO )
267 CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
268 INFOT = 9
269 CALL ZPPRFS( 'U', 2, 1, A, AF, B, 2, X, 1, R1, R2, W, R, INFO )
270 CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
271 *
272 * ZPPCON
273 *
274 SRNAMT = 'ZPPCON'
275 INFOT = 1
276 CALL ZPPCON( '/', 0, A, ANRM, RCOND, W, R, INFO )
277 CALL CHKXER( 'ZPPCON', INFOT, NOUT, LERR, OK )
278 INFOT = 2
279 CALL ZPPCON( 'U', -1, A, ANRM, RCOND, W, R, INFO )
280 CALL CHKXER( 'ZPPCON', INFOT, NOUT, LERR, OK )
281 INFOT = 4
282 CALL ZPPCON( 'U', 1, A, -ANRM, RCOND, W, R, INFO )
283 CALL CHKXER( 'ZPPCON', INFOT, NOUT, LERR, OK )
284 *
285 * ZPPEQU
286 *
287 SRNAMT = 'ZPPEQU'
288 INFOT = 1
289 CALL ZPPEQU( '/', 0, A, R1, RCOND, ANRM, INFO )
290 CALL CHKXER( 'ZPPEQU', INFOT, NOUT, LERR, OK )
291 INFOT = 2
292 CALL ZPPEQU( 'U', -1, A, R1, RCOND, ANRM, INFO )
293 CALL CHKXER( 'ZPPEQU', INFOT, NOUT, LERR, OK )
294 *
295 * Test error exits of the routines that use the Cholesky
296 * decomposition of a Hermitian positive definite band matrix.
297 *
298 ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN
299 *
300 * ZPBTRF
301 *
302 SRNAMT = 'ZPBTRF'
303 INFOT = 1
304 CALL ZPBTRF( '/', 0, 0, A, 1, INFO )
305 CALL CHKXER( 'ZPBTRF', INFOT, NOUT, LERR, OK )
306 INFOT = 2
307 CALL ZPBTRF( 'U', -1, 0, A, 1, INFO )
308 CALL CHKXER( 'ZPBTRF', INFOT, NOUT, LERR, OK )
309 INFOT = 3
310 CALL ZPBTRF( 'U', 1, -1, A, 1, INFO )
311 CALL CHKXER( 'ZPBTRF', INFOT, NOUT, LERR, OK )
312 INFOT = 5
313 CALL ZPBTRF( 'U', 2, 1, A, 1, INFO )
314 CALL CHKXER( 'ZPBTRF', INFOT, NOUT, LERR, OK )
315 *
316 * ZPBTF2
317 *
318 SRNAMT = 'ZPBTF2'
319 INFOT = 1
320 CALL ZPBTF2( '/', 0, 0, A, 1, INFO )
321 CALL CHKXER( 'ZPBTF2', INFOT, NOUT, LERR, OK )
322 INFOT = 2
323 CALL ZPBTF2( 'U', -1, 0, A, 1, INFO )
324 CALL CHKXER( 'ZPBTF2', INFOT, NOUT, LERR, OK )
325 INFOT = 3
326 CALL ZPBTF2( 'U', 1, -1, A, 1, INFO )
327 CALL CHKXER( 'ZPBTF2', INFOT, NOUT, LERR, OK )
328 INFOT = 5
329 CALL ZPBTF2( 'U', 2, 1, A, 1, INFO )
330 CALL CHKXER( 'ZPBTF2', INFOT, NOUT, LERR, OK )
331 *
332 * ZPBTRS
333 *
334 SRNAMT = 'ZPBTRS'
335 INFOT = 1
336 CALL ZPBTRS( '/', 0, 0, 0, A, 1, B, 1, INFO )
337 CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
338 INFOT = 2
339 CALL ZPBTRS( 'U', -1, 0, 0, A, 1, B, 1, INFO )
340 CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
341 INFOT = 3
342 CALL ZPBTRS( 'U', 1, -1, 0, A, 1, B, 1, INFO )
343 CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
344 INFOT = 4
345 CALL ZPBTRS( 'U', 0, 0, -1, A, 1, B, 1, INFO )
346 CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
347 INFOT = 6
348 CALL ZPBTRS( 'U', 2, 1, 1, A, 1, B, 1, INFO )
349 CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
350 INFOT = 8
351 CALL ZPBTRS( 'U', 2, 0, 1, A, 1, B, 1, INFO )
352 CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
353 *
354 * ZPBRFS
355 *
356 SRNAMT = 'ZPBRFS'
357 INFOT = 1
358 CALL ZPBRFS( '/', 0, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
359 $ R, INFO )
360 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
361 INFOT = 2
362 CALL ZPBRFS( 'U', -1, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
363 $ R, INFO )
364 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
365 INFOT = 3
366 CALL ZPBRFS( 'U', 1, -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
367 $ R, INFO )
368 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
369 INFOT = 4
370 CALL ZPBRFS( 'U', 0, 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
371 $ R, INFO )
372 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
373 INFOT = 6
374 CALL ZPBRFS( 'U', 2, 1, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W,
375 $ R, INFO )
376 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
377 INFOT = 8
378 CALL ZPBRFS( 'U', 2, 1, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W,
379 $ R, INFO )
380 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
381 INFOT = 10
382 CALL ZPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 1, X, 2, R1, R2, W,
383 $ R, INFO )
384 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
385 INFOT = 12
386 CALL ZPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 2, X, 1, R1, R2, W,
387 $ R, INFO )
388 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
389 *
390 * ZPBCON
391 *
392 SRNAMT = 'ZPBCON'
393 INFOT = 1
394 CALL ZPBCON( '/', 0, 0, A, 1, ANRM, RCOND, W, R, INFO )
395 CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
396 INFOT = 2
397 CALL ZPBCON( 'U', -1, 0, A, 1, ANRM, RCOND, W, R, INFO )
398 CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
399 INFOT = 3
400 CALL ZPBCON( 'U', 1, -1, A, 1, ANRM, RCOND, W, R, INFO )
401 CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
402 INFOT = 5
403 CALL ZPBCON( 'U', 2, 1, A, 1, ANRM, RCOND, W, R, INFO )
404 CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
405 INFOT = 6
406 CALL ZPBCON( 'U', 1, 0, A, 1, -ANRM, RCOND, W, R, INFO )
407 CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
408 *
409 * ZPBEQU
410 *
411 SRNAMT = 'ZPBEQU'
412 INFOT = 1
413 CALL ZPBEQU( '/', 0, 0, A, 1, R1, RCOND, ANRM, INFO )
414 CALL CHKXER( 'ZPBEQU', INFOT, NOUT, LERR, OK )
415 INFOT = 2
416 CALL ZPBEQU( 'U', -1, 0, A, 1, R1, RCOND, ANRM, INFO )
417 CALL CHKXER( 'ZPBEQU', INFOT, NOUT, LERR, OK )
418 INFOT = 3
419 CALL ZPBEQU( 'U', 1, -1, A, 1, R1, RCOND, ANRM, INFO )
420 CALL CHKXER( 'ZPBEQU', INFOT, NOUT, LERR, OK )
421 INFOT = 5
422 CALL ZPBEQU( 'U', 2, 1, A, 1, R1, RCOND, ANRM, INFO )
423 CALL CHKXER( 'ZPBEQU', INFOT, NOUT, LERR, OK )
424 END IF
425 *
426 * Print a summary line.
427 *
428 CALL ALAESM( PATH, OK, NOUT )
429 *
430 RETURN
431 *
432 * End of ZERRPO
433 *
434 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 * ZERRPO tests the error exits for the COMPLEX*16 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 DOUBLE PRECISION ANRM, RCOND
37 * ..
38 * .. Local Arrays ..
39 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX )
40 COMPLEX*16 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, ZPBCON, ZPBEQU, ZPBRFS, ZPBTF2,
49 $ ZPBTRF, ZPBTRS, ZPOCON, ZPOEQU, ZPORFS, ZPOTF2,
50 $ ZPOTRF, ZPOTRI, ZPOTRS, ZPPCON, ZPPEQU, ZPPRFS,
51 $ ZPPTRF, ZPPTRI, ZPPTRS
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 DBLE, DCMPLX
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 ) = DCMPLX( 1.D0 / DBLE( I+J ),
76 $ -1.D0 / DBLE( I+J ) )
77 AF( I, J ) = DCMPLX( 1.D0 / DBLE( I+J ),
78 $ -1.D0 / DBLE( I+J ) )
79 10 CONTINUE
80 B( J ) = 0.D0
81 R1( J ) = 0.D0
82 R2( J ) = 0.D0
83 W( J ) = 0.D0
84 X( J ) = 0.D0
85 20 CONTINUE
86 ANRM = 1.D0
87 OK = .TRUE.
88 *
89 * Test error exits of the routines that use the Cholesky
90 * decomposition of a Hermitian positive definite matrix.
91 *
92 IF( LSAMEN( 2, C2, 'PO' ) ) THEN
93 *
94 * ZPOTRF
95 *
96 SRNAMT = 'ZPOTRF'
97 INFOT = 1
98 CALL ZPOTRF( '/', 0, A, 1, INFO )
99 CALL CHKXER( 'ZPOTRF', INFOT, NOUT, LERR, OK )
100 INFOT = 2
101 CALL ZPOTRF( 'U', -1, A, 1, INFO )
102 CALL CHKXER( 'ZPOTRF', INFOT, NOUT, LERR, OK )
103 INFOT = 4
104 CALL ZPOTRF( 'U', 2, A, 1, INFO )
105 CALL CHKXER( 'ZPOTRF', INFOT, NOUT, LERR, OK )
106 *
107 * ZPOTF2
108 *
109 SRNAMT = 'ZPOTF2'
110 INFOT = 1
111 CALL ZPOTF2( '/', 0, A, 1, INFO )
112 CALL CHKXER( 'ZPOTF2', INFOT, NOUT, LERR, OK )
113 INFOT = 2
114 CALL ZPOTF2( 'U', -1, A, 1, INFO )
115 CALL CHKXER( 'ZPOTF2', INFOT, NOUT, LERR, OK )
116 INFOT = 4
117 CALL ZPOTF2( 'U', 2, A, 1, INFO )
118 CALL CHKXER( 'ZPOTF2', INFOT, NOUT, LERR, OK )
119 *
120 * ZPOTRI
121 *
122 SRNAMT = 'ZPOTRI'
123 INFOT = 1
124 CALL ZPOTRI( '/', 0, A, 1, INFO )
125 CALL CHKXER( 'ZPOTRI', INFOT, NOUT, LERR, OK )
126 INFOT = 2
127 CALL ZPOTRI( 'U', -1, A, 1, INFO )
128 CALL CHKXER( 'ZPOTRI', INFOT, NOUT, LERR, OK )
129 INFOT = 4
130 CALL ZPOTRI( 'U', 2, A, 1, INFO )
131 CALL CHKXER( 'ZPOTRI', INFOT, NOUT, LERR, OK )
132 *
133 * ZPOTRS
134 *
135 SRNAMT = 'ZPOTRS'
136 INFOT = 1
137 CALL ZPOTRS( '/', 0, 0, A, 1, B, 1, INFO )
138 CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
139 INFOT = 2
140 CALL ZPOTRS( 'U', -1, 0, A, 1, B, 1, INFO )
141 CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
142 INFOT = 3
143 CALL ZPOTRS( 'U', 0, -1, A, 1, B, 1, INFO )
144 CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
145 INFOT = 5
146 CALL ZPOTRS( 'U', 2, 1, A, 1, B, 2, INFO )
147 CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
148 INFOT = 7
149 CALL ZPOTRS( 'U', 2, 1, A, 2, B, 1, INFO )
150 CALL CHKXER( 'ZPOTRS', INFOT, NOUT, LERR, OK )
151 *
152 * ZPORFS
153 *
154 SRNAMT = 'ZPORFS'
155 INFOT = 1
156 CALL ZPORFS( '/', 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
157 $ INFO )
158 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
159 INFOT = 2
160 CALL ZPORFS( 'U', -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
161 $ INFO )
162 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
163 INFOT = 3
164 CALL ZPORFS( 'U', 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, R,
165 $ INFO )
166 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
167 INFOT = 5
168 CALL ZPORFS( 'U', 2, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, R,
169 $ INFO )
170 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
171 INFOT = 7
172 CALL ZPORFS( 'U', 2, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, R,
173 $ INFO )
174 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
175 INFOT = 9
176 CALL ZPORFS( 'U', 2, 1, A, 2, AF, 2, B, 1, X, 2, R1, R2, W, R,
177 $ INFO )
178 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
179 INFOT = 11
180 CALL ZPORFS( 'U', 2, 1, A, 2, AF, 2, B, 2, X, 1, R1, R2, W, R,
181 $ INFO )
182 CALL CHKXER( 'ZPORFS', INFOT, NOUT, LERR, OK )
183 *
184 * ZPOCON
185 *
186 SRNAMT = 'ZPOCON'
187 INFOT = 1
188 CALL ZPOCON( '/', 0, A, 1, ANRM, RCOND, W, R, INFO )
189 CALL CHKXER( 'ZPOCON', INFOT, NOUT, LERR, OK )
190 INFOT = 2
191 CALL ZPOCON( 'U', -1, A, 1, ANRM, RCOND, W, R, INFO )
192 CALL CHKXER( 'ZPOCON', INFOT, NOUT, LERR, OK )
193 INFOT = 4
194 CALL ZPOCON( 'U', 2, A, 1, ANRM, RCOND, W, R, INFO )
195 CALL CHKXER( 'ZPOCON', INFOT, NOUT, LERR, OK )
196 INFOT = 5
197 CALL ZPOCON( 'U', 1, A, 1, -ANRM, RCOND, W, R, INFO )
198 CALL CHKXER( 'ZPOCON', INFOT, NOUT, LERR, OK )
199 *
200 * ZPOEQU
201 *
202 SRNAMT = 'ZPOEQU'
203 INFOT = 1
204 CALL ZPOEQU( -1, A, 1, R1, RCOND, ANRM, INFO )
205 CALL CHKXER( 'ZPOEQU', INFOT, NOUT, LERR, OK )
206 INFOT = 3
207 CALL ZPOEQU( 2, A, 1, R1, RCOND, ANRM, INFO )
208 CALL CHKXER( 'ZPOEQU', INFOT, NOUT, LERR, OK )
209 *
210 * Test error exits of the routines that use the Cholesky
211 * decomposition of a Hermitian positive definite packed matrix.
212 *
213 ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN
214 *
215 * ZPPTRF
216 *
217 SRNAMT = 'ZPPTRF'
218 INFOT = 1
219 CALL ZPPTRF( '/', 0, A, INFO )
220 CALL CHKXER( 'ZPPTRF', INFOT, NOUT, LERR, OK )
221 INFOT = 2
222 CALL ZPPTRF( 'U', -1, A, INFO )
223 CALL CHKXER( 'ZPPTRF', INFOT, NOUT, LERR, OK )
224 *
225 * ZPPTRI
226 *
227 SRNAMT = 'ZPPTRI'
228 INFOT = 1
229 CALL ZPPTRI( '/', 0, A, INFO )
230 CALL CHKXER( 'ZPPTRI', INFOT, NOUT, LERR, OK )
231 INFOT = 2
232 CALL ZPPTRI( 'U', -1, A, INFO )
233 CALL CHKXER( 'ZPPTRI', INFOT, NOUT, LERR, OK )
234 *
235 * ZPPTRS
236 *
237 SRNAMT = 'ZPPTRS'
238 INFOT = 1
239 CALL ZPPTRS( '/', 0, 0, A, B, 1, INFO )
240 CALL CHKXER( 'ZPPTRS', INFOT, NOUT, LERR, OK )
241 INFOT = 2
242 CALL ZPPTRS( 'U', -1, 0, A, B, 1, INFO )
243 CALL CHKXER( 'ZPPTRS', INFOT, NOUT, LERR, OK )
244 INFOT = 3
245 CALL ZPPTRS( 'U', 0, -1, A, B, 1, INFO )
246 CALL CHKXER( 'ZPPTRS', INFOT, NOUT, LERR, OK )
247 INFOT = 6
248 CALL ZPPTRS( 'U', 2, 1, A, B, 1, INFO )
249 CALL CHKXER( 'ZPPTRS', INFOT, NOUT, LERR, OK )
250 *
251 * ZPPRFS
252 *
253 SRNAMT = 'ZPPRFS'
254 INFOT = 1
255 CALL ZPPRFS( '/', 0, 0, A, AF, B, 1, X, 1, R1, R2, W, R, INFO )
256 CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
257 INFOT = 2
258 CALL ZPPRFS( 'U', -1, 0, A, AF, B, 1, X, 1, R1, R2, W, R,
259 $ INFO )
260 CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
261 INFOT = 3
262 CALL ZPPRFS( 'U', 0, -1, A, AF, B, 1, X, 1, R1, R2, W, R,
263 $ INFO )
264 CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
265 INFOT = 7
266 CALL ZPPRFS( 'U', 2, 1, A, AF, B, 1, X, 2, R1, R2, W, R, INFO )
267 CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
268 INFOT = 9
269 CALL ZPPRFS( 'U', 2, 1, A, AF, B, 2, X, 1, R1, R2, W, R, INFO )
270 CALL CHKXER( 'ZPPRFS', INFOT, NOUT, LERR, OK )
271 *
272 * ZPPCON
273 *
274 SRNAMT = 'ZPPCON'
275 INFOT = 1
276 CALL ZPPCON( '/', 0, A, ANRM, RCOND, W, R, INFO )
277 CALL CHKXER( 'ZPPCON', INFOT, NOUT, LERR, OK )
278 INFOT = 2
279 CALL ZPPCON( 'U', -1, A, ANRM, RCOND, W, R, INFO )
280 CALL CHKXER( 'ZPPCON', INFOT, NOUT, LERR, OK )
281 INFOT = 4
282 CALL ZPPCON( 'U', 1, A, -ANRM, RCOND, W, R, INFO )
283 CALL CHKXER( 'ZPPCON', INFOT, NOUT, LERR, OK )
284 *
285 * ZPPEQU
286 *
287 SRNAMT = 'ZPPEQU'
288 INFOT = 1
289 CALL ZPPEQU( '/', 0, A, R1, RCOND, ANRM, INFO )
290 CALL CHKXER( 'ZPPEQU', INFOT, NOUT, LERR, OK )
291 INFOT = 2
292 CALL ZPPEQU( 'U', -1, A, R1, RCOND, ANRM, INFO )
293 CALL CHKXER( 'ZPPEQU', INFOT, NOUT, LERR, OK )
294 *
295 * Test error exits of the routines that use the Cholesky
296 * decomposition of a Hermitian positive definite band matrix.
297 *
298 ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN
299 *
300 * ZPBTRF
301 *
302 SRNAMT = 'ZPBTRF'
303 INFOT = 1
304 CALL ZPBTRF( '/', 0, 0, A, 1, INFO )
305 CALL CHKXER( 'ZPBTRF', INFOT, NOUT, LERR, OK )
306 INFOT = 2
307 CALL ZPBTRF( 'U', -1, 0, A, 1, INFO )
308 CALL CHKXER( 'ZPBTRF', INFOT, NOUT, LERR, OK )
309 INFOT = 3
310 CALL ZPBTRF( 'U', 1, -1, A, 1, INFO )
311 CALL CHKXER( 'ZPBTRF', INFOT, NOUT, LERR, OK )
312 INFOT = 5
313 CALL ZPBTRF( 'U', 2, 1, A, 1, INFO )
314 CALL CHKXER( 'ZPBTRF', INFOT, NOUT, LERR, OK )
315 *
316 * ZPBTF2
317 *
318 SRNAMT = 'ZPBTF2'
319 INFOT = 1
320 CALL ZPBTF2( '/', 0, 0, A, 1, INFO )
321 CALL CHKXER( 'ZPBTF2', INFOT, NOUT, LERR, OK )
322 INFOT = 2
323 CALL ZPBTF2( 'U', -1, 0, A, 1, INFO )
324 CALL CHKXER( 'ZPBTF2', INFOT, NOUT, LERR, OK )
325 INFOT = 3
326 CALL ZPBTF2( 'U', 1, -1, A, 1, INFO )
327 CALL CHKXER( 'ZPBTF2', INFOT, NOUT, LERR, OK )
328 INFOT = 5
329 CALL ZPBTF2( 'U', 2, 1, A, 1, INFO )
330 CALL CHKXER( 'ZPBTF2', INFOT, NOUT, LERR, OK )
331 *
332 * ZPBTRS
333 *
334 SRNAMT = 'ZPBTRS'
335 INFOT = 1
336 CALL ZPBTRS( '/', 0, 0, 0, A, 1, B, 1, INFO )
337 CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
338 INFOT = 2
339 CALL ZPBTRS( 'U', -1, 0, 0, A, 1, B, 1, INFO )
340 CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
341 INFOT = 3
342 CALL ZPBTRS( 'U', 1, -1, 0, A, 1, B, 1, INFO )
343 CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
344 INFOT = 4
345 CALL ZPBTRS( 'U', 0, 0, -1, A, 1, B, 1, INFO )
346 CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
347 INFOT = 6
348 CALL ZPBTRS( 'U', 2, 1, 1, A, 1, B, 1, INFO )
349 CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
350 INFOT = 8
351 CALL ZPBTRS( 'U', 2, 0, 1, A, 1, B, 1, INFO )
352 CALL CHKXER( 'ZPBTRS', INFOT, NOUT, LERR, OK )
353 *
354 * ZPBRFS
355 *
356 SRNAMT = 'ZPBRFS'
357 INFOT = 1
358 CALL ZPBRFS( '/', 0, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
359 $ R, INFO )
360 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
361 INFOT = 2
362 CALL ZPBRFS( 'U', -1, 0, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
363 $ R, INFO )
364 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
365 INFOT = 3
366 CALL ZPBRFS( 'U', 1, -1, 0, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
367 $ R, INFO )
368 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
369 INFOT = 4
370 CALL ZPBRFS( 'U', 0, 0, -1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
371 $ R, INFO )
372 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
373 INFOT = 6
374 CALL ZPBRFS( 'U', 2, 1, 1, A, 1, AF, 2, B, 2, X, 2, R1, R2, W,
375 $ R, INFO )
376 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
377 INFOT = 8
378 CALL ZPBRFS( 'U', 2, 1, 1, A, 2, AF, 1, B, 2, X, 2, R1, R2, W,
379 $ R, INFO )
380 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
381 INFOT = 10
382 CALL ZPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 1, X, 2, R1, R2, W,
383 $ R, INFO )
384 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
385 INFOT = 12
386 CALL ZPBRFS( 'U', 2, 0, 1, A, 1, AF, 1, B, 2, X, 1, R1, R2, W,
387 $ R, INFO )
388 CALL CHKXER( 'ZPBRFS', INFOT, NOUT, LERR, OK )
389 *
390 * ZPBCON
391 *
392 SRNAMT = 'ZPBCON'
393 INFOT = 1
394 CALL ZPBCON( '/', 0, 0, A, 1, ANRM, RCOND, W, R, INFO )
395 CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
396 INFOT = 2
397 CALL ZPBCON( 'U', -1, 0, A, 1, ANRM, RCOND, W, R, INFO )
398 CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
399 INFOT = 3
400 CALL ZPBCON( 'U', 1, -1, A, 1, ANRM, RCOND, W, R, INFO )
401 CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
402 INFOT = 5
403 CALL ZPBCON( 'U', 2, 1, A, 1, ANRM, RCOND, W, R, INFO )
404 CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
405 INFOT = 6
406 CALL ZPBCON( 'U', 1, 0, A, 1, -ANRM, RCOND, W, R, INFO )
407 CALL CHKXER( 'ZPBCON', INFOT, NOUT, LERR, OK )
408 *
409 * ZPBEQU
410 *
411 SRNAMT = 'ZPBEQU'
412 INFOT = 1
413 CALL ZPBEQU( '/', 0, 0, A, 1, R1, RCOND, ANRM, INFO )
414 CALL CHKXER( 'ZPBEQU', INFOT, NOUT, LERR, OK )
415 INFOT = 2
416 CALL ZPBEQU( 'U', -1, 0, A, 1, R1, RCOND, ANRM, INFO )
417 CALL CHKXER( 'ZPBEQU', INFOT, NOUT, LERR, OK )
418 INFOT = 3
419 CALL ZPBEQU( 'U', 1, -1, A, 1, R1, RCOND, ANRM, INFO )
420 CALL CHKXER( 'ZPBEQU', INFOT, NOUT, LERR, OK )
421 INFOT = 5
422 CALL ZPBEQU( 'U', 2, 1, A, 1, R1, RCOND, ANRM, INFO )
423 CALL CHKXER( 'ZPBEQU', INFOT, NOUT, LERR, OK )
424 END IF
425 *
426 * Print a summary line.
427 *
428 CALL ALAESM( PATH, OK, NOUT )
429 *
430 RETURN
431 *
432 * End of ZERRPO
433 *
434 END