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 November 2013
52*
53*> \ingroup complex_lin
54*
55*  =====================================================================
56      SUBROUTINE CERRSY( PATH, NUNIT )
57*
58*  -- LAPACK test routine (version 3.5.0) --
59*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
60*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61*     November 2013
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, CSYCON_ROOK, CSYRFS, CSYTF2,
92     $                   CSYTF2_ROOK, CSYTRF, CSYTRF_ROOK, CSYTRI,
93     $                   CSYTRI_ROOK, CSYTRI2, CSYTRS, CSYTRS_ROOK
94*     ..
95*     .. Scalars in Common ..
96      LOGICAL            LERR, OK
97      CHARACTER*32       SRNAMT
98      INTEGER            INFOT, NOUT
99*     ..
100*     .. Common blocks ..
101      COMMON             / INFOC / INFOT, NOUT, OK, LERR
102      COMMON             / SRNAMC / SRNAMT
103*     ..
104*     .. Intrinsic Functions ..
105      INTRINSIC          CMPLX, REAL
106*     ..
107*     .. Executable Statements ..
108*
109      NOUT = NUNIT
110      WRITE( NOUT, FMT = * )
111      C2 = PATH( 2: 3 )
112*
113*     Set the variables to innocuous values.
114*
115      DO 20 J = 1, NMAX
116         DO 10 I = 1, NMAX
117            A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
118            AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
119   10    CONTINUE
120         B( J ) = 0.
121         R1( J ) = 0.
122         R2( J ) = 0.
123         W( J ) = 0.
124         X( J ) = 0.
125         IP( J ) = J
126   20 CONTINUE
127      ANRM = 1.0
128      OK = .TRUE.
129*
130*     Test error exits of the routines that use factorization
131*     of a symmetric indefinite matrix with patrial
132*     (Bunch-Kaufman) diagonal pivoting method.
133*
134      IF( LSAMEN( 2, C2, 'SY' ) ) THEN
135*
136*        CSYTRF
137*
138         SRNAMT = 'CSYTRF'
139         INFOT = 1
140         CALL CSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
141         CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
142         INFOT = 2
143         CALL CSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
144         CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
145         INFOT = 4
146         CALL CSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
147         CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
148*
149*        CSYTF2
150*
151         SRNAMT = 'CSYTF2'
152         INFOT = 1
153         CALL CSYTF2( '/', 0, A, 1, IP, INFO )
154         CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
155         INFOT = 2
156         CALL CSYTF2( 'U', -1, A, 1, IP, INFO )
157         CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
158         INFOT = 4
159         CALL CSYTF2( 'U', 2, A, 1, IP, INFO )
160         CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
161*
162*        CSYTRI
163*
164         SRNAMT = 'CSYTRI'
165         INFOT = 1
166         CALL CSYTRI( '/', 0, A, 1, IP, W, INFO )
167         CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
168         INFOT = 2
169         CALL CSYTRI( 'U', -1, A, 1, IP, W, INFO )
170         CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
171         INFOT = 4
172         CALL CSYTRI( 'U', 2, A, 1, IP, W, INFO )
173         CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
174*
175*        CSYTRI2
176*
177         SRNAMT = 'CSYTRI2'
178         INFOT = 1
179         CALL CSYTRI2( '/', 0, A, 1, IP, W, 1, INFO )
180         CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
181         INFOT = 2
182         CALL CSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO )
183         CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
184         INFOT = 4
185         CALL CSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO )
186         CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
187*
188*        CSYTRS
189*
190         SRNAMT = 'CSYTRS'
191         INFOT = 1
192         CALL CSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
193         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
194         INFOT = 2
195         CALL CSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
196         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
197         INFOT = 3
198         CALL CSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
199         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
200         INFOT = 5
201         CALL CSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
202         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
203         INFOT = 8
204         CALL CSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
205         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
206*
207*        CSYRFS
208*
209         SRNAMT = 'CSYRFS'
210         INFOT = 1
211         CALL CSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
212     $                R, INFO )
213         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
214         INFOT = 2
215         CALL CSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
216     $                W, R, INFO )
217         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
218         INFOT = 3
219         CALL CSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
220     $                W, R, INFO )
221         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
222         INFOT = 5
223         CALL CSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
224     $                R, INFO )
225         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
226         INFOT = 7
227         CALL CSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
228     $                R, INFO )
229         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
230         INFOT = 10
231         CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
232     $                R, INFO )
233         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
234         INFOT = 12
235         CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
236     $                R, INFO )
237         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
238*
239*        CSYCON
240*
241         SRNAMT = 'CSYCON'
242         INFOT = 1
243         CALL CSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
244         CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
245         INFOT = 2
246         CALL CSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
247         CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
248         INFOT = 4
249         CALL CSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
250         CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
251         INFOT = 6
252         CALL CSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
253         CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
254*
255*     Test error exits of the routines that use factorization
256*     of a symmetric indefinite matrix with "rook"
257*     (bounded Bunch-Kaufman) diagonal pivoting method.
258*
259      ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
260*
261*        CSYTRF_ROOK
262*
263         SRNAMT = 'CSYTRF_ROOK'
264         INFOT = 1
265         CALL CSYTRF_ROOK( '/', 0, A, 1, IP, W, 1, INFO )
266         CALL CHKXER( 'CSYTRF_ROOK', INFOT, NOUT, LERR, OK )
267         INFOT = 2
268         CALL CSYTRF_ROOK( 'U', -1, A, 1, IP, W, 1, INFO )
269         CALL CHKXER( 'CSYTRF_ROOK', INFOT, NOUT, LERR, OK )
270         INFOT = 4
271         CALL CSYTRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
272         CALL CHKXER( 'CSYTRF_ROOK', INFOT, NOUT, LERR, OK )
273*
274*        CSYTF2_ROOK
275*
276         SRNAMT = 'CSYTF2_ROOK'
277         INFOT = 1
278         CALL CSYTF2_ROOK( '/', 0, A, 1, IP, INFO )
279         CALL CHKXER( 'CSYTF2_ROOK', INFOT, NOUT, LERR, OK )
280         INFOT = 2
281         CALL CSYTF2_ROOK( 'U', -1, A, 1, IP, INFO )
282         CALL CHKXER( 'CSYTF2_ROOK', INFOT, NOUT, LERR, OK )
283         INFOT = 4
284         CALL CSYTF2_ROOK( 'U', 2, A, 1, IP, INFO )
285         CALL CHKXER( 'CSYTF2_ROOK', INFOT, NOUT, LERR, OK )
286*
287*        CSYTRI_ROOK
288*
289         SRNAMT = 'CSYTRI_ROOK'
290         INFOT = 1
291         CALL CSYTRI_ROOK( '/', 0, A, 1, IP, W, INFO )
292         CALL CHKXER( 'CSYTRI_ROOK', INFOT, NOUT, LERR, OK )
293         INFOT = 2
294         CALL CSYTRI_ROOK( 'U', -1, A, 1, IP, W, INFO )
295         CALL CHKXER( 'CSYTRI_ROOK', INFOT, NOUT, LERR, OK )
296         INFOT = 4
297         CALL CSYTRI_ROOK( 'U', 2, A, 1, IP, W, INFO )
298         CALL CHKXER( 'CSYTRI_ROOK', INFOT, NOUT, LERR, OK )
299*
300*        CSYTRS_ROOK
301*
302         SRNAMT = 'CSYTRS_ROOK'
303         INFOT = 1
304         CALL CSYTRS_ROOK( '/', 0, 0, A, 1, IP, B, 1, INFO )
305         CALL CHKXER( 'CSYTRS_ROOK', INFOT, NOUT, LERR, OK )
306         INFOT = 2
307         CALL CSYTRS_ROOK( 'U', -1, 0, A, 1, IP, B, 1, INFO )
308         CALL CHKXER( 'CSYTRS_ROOK', INFOT, NOUT, LERR, OK )
309         INFOT = 3
310         CALL CSYTRS_ROOK( 'U', 0, -1, A, 1, IP, B, 1, INFO )
311         CALL CHKXER( 'CSYTRS_ROOK', INFOT, NOUT, LERR, OK )
312         INFOT = 5
313         CALL CSYTRS_ROOK( 'U', 2, 1, A, 1, IP, B, 2, INFO )
314         CALL CHKXER( 'CSYTRS_ROOK', INFOT, NOUT, LERR, OK )
315         INFOT = 8
316         CALL CSYTRS_ROOK( 'U', 2, 1, A, 2, IP, B, 1, INFO )
317         CALL CHKXER( 'CSYTRS_ROOK', INFOT, NOUT, LERR, OK )
318*
319*        CSYCON_ROOK
320*
321         SRNAMT = 'CSYCON_ROOK'
322         INFOT = 1
323         CALL CSYCON_ROOK( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
324         CALL CHKXER( 'CSYCON_ROOK', INFOT, NOUT, LERR, OK )
325         INFOT = 2
326         CALL CSYCON_ROOK( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
327         CALL CHKXER( 'CSYCON_ROOK', INFOT, NOUT, LERR, OK )
328         INFOT = 4
329         CALL CSYCON_ROOK( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
330         CALL CHKXER( 'CSYCON_ROOK', INFOT, NOUT, LERR, OK )
331         INFOT = 6
332         CALL CSYCON_ROOK( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
333         CALL CHKXER( 'CSYCON_ROOK', INFOT, NOUT, LERR, OK )
334*
335*     Test error exits of the routines that use factorization
336*     of a symmetric indefinite packed matrix with patrial
337*     (Bunch-Kaufman) diagonal pivoting method.
338*
339      ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
340*
341*        CSPTRF
342*
343         SRNAMT = 'CSPTRF'
344         INFOT = 1
345         CALL CSPTRF( '/', 0, A, IP, INFO )
346         CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK )
347         INFOT = 2
348         CALL CSPTRF( 'U', -1, A, IP, INFO )
349         CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK )
350*
351*        CSPTRI
352*
353         SRNAMT = 'CSPTRI'
354         INFOT = 1
355         CALL CSPTRI( '/', 0, A, IP, W, INFO )
356         CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK )
357         INFOT = 2
358         CALL CSPTRI( 'U', -1, A, IP, W, INFO )
359         CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK )
360*
361*        CSPTRS
362*
363         SRNAMT = 'CSPTRS'
364         INFOT = 1
365         CALL CSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
366         CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
367         INFOT = 2
368         CALL CSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
369         CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
370         INFOT = 3
371         CALL CSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
372         CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
373         INFOT = 7
374         CALL CSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
375         CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
376*
377*        CSPRFS
378*
379         SRNAMT = 'CSPRFS'
380         INFOT = 1
381         CALL CSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
382     $                INFO )
383         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
384         INFOT = 2
385         CALL CSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
386     $                INFO )
387         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
388         INFOT = 3
389         CALL CSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
390     $                INFO )
391         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
392         INFOT = 8
393         CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
394     $                INFO )
395         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
396         INFOT = 10
397         CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
398     $                INFO )
399         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
400*
401*        CSPCON
402*
403         SRNAMT = 'CSPCON'
404         INFOT = 1
405         CALL CSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO )
406         CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
407         INFOT = 2
408         CALL CSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO )
409         CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
410         INFOT = 5
411         CALL CSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
412         CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
413      END IF
414*
415*     Print a summary line.
416*
417      CALL ALAESM( PATH, OK, NOUT )
418*
419      RETURN
420*
421*     End of CERRSY
422*
423      END
424