1*> \brief \b CERRSY
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 CERRSY( 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*> CERRSY tests the error exits for the COMPLEX routines
25*> for symmetric indefinite 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*> \date April 2012
52*
53*> \ingroup complex_lin
54*
55*  =====================================================================
56      SUBROUTINE CERRSY( PATH, NUNIT )
57*
58*  -- LAPACK test routine (version 3.4.1) --
59*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
60*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61*     April 2012
62*
63*     .. Scalar Arguments ..
64      CHARACTER*3        PATH
65      INTEGER            NUNIT
66*     ..
67*
68*  =====================================================================
69*
70*     .. Parameters ..
71      INTEGER            NMAX
72      PARAMETER          ( NMAX = 4 )
73*     ..
74*     .. Local Scalars ..
75      CHARACTER*2        C2
76      INTEGER            I, INFO, J
77      REAL               ANRM, RCOND
78*     ..
79*     .. Local Arrays ..
80      INTEGER            IP( NMAX )
81      REAL               R( NMAX ), R1( NMAX ), R2( NMAX )
82      COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
83     $                   W( 2*NMAX ), X( NMAX )
84*     ..
85*     .. External Functions ..
86      LOGICAL            LSAMEN
87      EXTERNAL           LSAMEN
88*     ..
89*     .. External Subroutines ..
90      EXTERNAL           ALAESM, CHKXER, CSPCON, CSPRFS, CSPTRF, CSPTRI,
91     $                   CSPTRS, CSYCON, CSYRFS, CSYTF2, CSYTRF, CSYTRI,
92     $                   CSYTRI2, CSYTRS
93*     ..
94*     .. Scalars in Common ..
95      LOGICAL            LERR, OK
96      CHARACTER*32       SRNAMT
97      INTEGER            INFOT, NOUT
98*     ..
99*     .. Common blocks ..
100      COMMON             / INFOC / INFOT, NOUT, OK, LERR
101      COMMON             / SRNAMC / SRNAMT
102*     ..
103*     .. Intrinsic Functions ..
104      INTRINSIC          CMPLX, REAL
105*     ..
106*     .. Executable Statements ..
107*
108      NOUT = NUNIT
109      WRITE( NOUT, FMT = * )
110      C2 = PATH( 2: 3 )
111*
112*     Set the variables to innocuous values.
113*
114      DO 20 J = 1, NMAX
115         DO 10 I = 1, NMAX
116            A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
117            AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
118   10    CONTINUE
119         B( J ) = 0.
120         R1( J ) = 0.
121         R2( J ) = 0.
122         W( J ) = 0.
123         X( J ) = 0.
124         IP( J ) = J
125   20 CONTINUE
126      ANRM = 1.0
127      OK = .TRUE.
128*
129      IF( LSAMEN( 2, C2, 'SY' ) ) THEN
130*
131*        Test error exits of the routines that use factorization
132*        of a symmetric indefinite matrix with patrial
133*        (Bunch-Kaufman) pivoting.
134*
135*        CSYTRF
136*
137         SRNAMT = 'CSYTRF'
138         INFOT = 1
139         CALL CSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
140         CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
141         INFOT = 2
142         CALL CSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
143         CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
144         INFOT = 4
145         CALL CSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
146         CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
147*
148*        CSYTF2
149*
150         SRNAMT = 'CSYTF2'
151         INFOT = 1
152         CALL CSYTF2( '/', 0, A, 1, IP, INFO )
153         CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
154         INFOT = 2
155         CALL CSYTF2( 'U', -1, A, 1, IP, INFO )
156         CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
157         INFOT = 4
158         CALL CSYTF2( 'U', 2, A, 1, IP, INFO )
159         CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
160*
161*        CSYTRI
162*
163         SRNAMT = 'CSYTRI'
164         INFOT = 1
165         CALL CSYTRI( '/', 0, A, 1, IP, W, INFO )
166         CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
167         INFOT = 2
168         CALL CSYTRI( 'U', -1, A, 1, IP, W, INFO )
169         CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
170         INFOT = 4
171         CALL CSYTRI( 'U', 2, A, 1, IP, W, INFO )
172         CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
173*
174*        CSYTRI2
175*
176         SRNAMT = 'CSYTRI2'
177         INFOT = 1
178         CALL CSYTRI2( '/', 0, A, 1, IP, W, 1, INFO )
179         CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
180         INFOT = 2
181         CALL CSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO )
182         CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
183         INFOT = 4
184         CALL CSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO )
185         CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
186*
187*        CSYTRS
188*
189         SRNAMT = 'CSYTRS'
190         INFOT = 1
191         CALL CSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
192         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
193         INFOT = 2
194         CALL CSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
195         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
196         INFOT = 3
197         CALL CSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
198         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
199         INFOT = 5
200         CALL CSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
201         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
202         INFOT = 8
203         CALL CSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
204         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
205*
206*        CSYRFS
207*
208         SRNAMT = 'CSYRFS'
209         INFOT = 1
210         CALL CSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
211     $                R, INFO )
212         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
213         INFOT = 2
214         CALL CSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
215     $                W, R, INFO )
216         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
217         INFOT = 3
218         CALL CSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
219     $                W, R, INFO )
220         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
221         INFOT = 5
222         CALL CSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
223     $                R, INFO )
224         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
225         INFOT = 7
226         CALL CSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
227     $                R, INFO )
228         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
229         INFOT = 10
230         CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
231     $                R, INFO )
232         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
233         INFOT = 12
234         CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
235     $                R, INFO )
236         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
237*
238*        CSYCON
239*
240         SRNAMT = 'CSYCON'
241         INFOT = 1
242         CALL CSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
243         CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
244         INFOT = 2
245         CALL CSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
246         CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
247         INFOT = 4
248         CALL CSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
249         CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
250         INFOT = 6
251         CALL CSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
252         CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
253*
254      ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
255*
256*        Test error exits of the routines that use factorization
257*        of a symmetric indefinite packed matrix with patrial
258*        (Bunch-Kaufman) pivoting.
259*
260*        CSPTRF
261*
262         SRNAMT = 'CSPTRF'
263         INFOT = 1
264         CALL CSPTRF( '/', 0, A, IP, INFO )
265         CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK )
266         INFOT = 2
267         CALL CSPTRF( 'U', -1, A, IP, INFO )
268         CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK )
269*
270*        CSPTRI
271*
272         SRNAMT = 'CSPTRI'
273         INFOT = 1
274         CALL CSPTRI( '/', 0, A, IP, W, INFO )
275         CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK )
276         INFOT = 2
277         CALL CSPTRI( 'U', -1, A, IP, W, INFO )
278         CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK )
279*
280*        CSPTRS
281*
282         SRNAMT = 'CSPTRS'
283         INFOT = 1
284         CALL CSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
285         CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
286         INFOT = 2
287         CALL CSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
288         CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
289         INFOT = 3
290         CALL CSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
291         CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
292         INFOT = 7
293         CALL CSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
294         CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
295*
296*        CSPRFS
297*
298         SRNAMT = 'CSPRFS'
299         INFOT = 1
300         CALL CSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
301     $                INFO )
302         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
303         INFOT = 2
304         CALL CSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
305     $                INFO )
306         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
307         INFOT = 3
308         CALL CSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
309     $                INFO )
310         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
311         INFOT = 8
312         CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
313     $                INFO )
314         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
315         INFOT = 10
316         CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
317     $                INFO )
318         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
319*
320*        CSPCON
321*
322         SRNAMT = 'CSPCON'
323         INFOT = 1
324         CALL CSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO )
325         CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
326         INFOT = 2
327         CALL CSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO )
328         CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
329         INFOT = 5
330         CALL CSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
331         CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
332      END IF
333*
334*     Print a summary line.
335*
336      CALL ALAESM( PATH, OK, NOUT )
337*
338      RETURN
339*
340*     End of CERRSY
341*
342      END
343