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