1*> \brief \b CERRSYX
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*>
27*> Note that this file is used only when the XBLAS are available,
28*> otherwise cerrsy.f defines this subroutine.
29*> \endverbatim
30*
31*  Arguments:
32*  ==========
33*
34*> \param[in] PATH
35*> \verbatim
36*>          PATH is CHARACTER*3
37*>          The LAPACK path name for the routines to be tested.
38*> \endverbatim
39*>
40*> \param[in] NUNIT
41*> \verbatim
42*>          NUNIT is INTEGER
43*>          The unit number for output.
44*> \endverbatim
45*
46*  Authors:
47*  ========
48*
49*> \author Univ. of Tennessee
50*> \author Univ. of California Berkeley
51*> \author Univ. of Colorado Denver
52*> \author NAG Ltd.
53*
54*> \date November 2011
55*
56*> \ingroup complex_lin
57*
58*  =====================================================================
59      SUBROUTINE CERRSY( PATH, NUNIT )
60*
61*  -- LAPACK test routine (version 3.4.0) --
62*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
63*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
64*     November 2011
65*
66*     .. Scalar Arguments ..
67      CHARACTER*3        PATH
68      INTEGER            NUNIT
69*     ..
70*
71*  =====================================================================
72*
73*     .. Parameters ..
74      INTEGER            NMAX
75      PARAMETER          ( NMAX = 4 )
76*     ..
77*     .. Local Scalars ..
78      CHARACTER          EQ
79      CHARACTER*2        C2
80      INTEGER            I, INFO, J, N_ERR_BNDS, NPARAMS
81      REAL               ANRM, RCOND, BERR
82*     ..
83*     .. Local Arrays ..
84      INTEGER            IP( NMAX )
85      REAL               R( NMAX ), R1( NMAX ), R2( NMAX ),
86     $                   S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
87     $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
88      COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
89     $                   W( 2*NMAX ), X( NMAX )
90*     ..
91*     .. External Functions ..
92      LOGICAL            LSAMEN
93      EXTERNAL           LSAMEN
94*     ..
95*     .. External Subroutines ..
96      EXTERNAL           ALAESM, CHKXER, CSPCON, CSPRFS, CSPTRF, CSPTRI,
97     $                   CSPTRS, CSYCON, CSYRFS, CSYTF2, CSYTRF, CSYTRI,
98     $                   CSYTRI2, CSYTRS, CSYRFSX
99*     ..
100*     .. Scalars in Common ..
101      LOGICAL            LERR, OK
102      CHARACTER*32       SRNAMT
103      INTEGER            INFOT, NOUT
104*     ..
105*     .. Common blocks ..
106      COMMON             / INFOC / INFOT, NOUT, OK, LERR
107      COMMON             / SRNAMC / SRNAMT
108*     ..
109*     .. Intrinsic Functions ..
110      INTRINSIC          CMPLX, REAL
111*     ..
112*     .. Executable Statements ..
113*
114      NOUT = NUNIT
115      WRITE( NOUT, FMT = * )
116      C2 = PATH( 2: 3 )
117*
118*     Set the variables to innocuous values.
119*
120      DO 20 J = 1, NMAX
121         DO 10 I = 1, NMAX
122            A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
123            AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) )
124   10    CONTINUE
125         B( J ) = 0.
126         R1( J ) = 0.
127         R2( J ) = 0.
128         W( J ) = 0.
129         X( J ) = 0.
130         S( J ) = 0.
131         IP( J ) = J
132   20 CONTINUE
133      ANRM = 1.0
134      OK = .TRUE.
135*
136*     Test error exits of the routines that use the diagonal pivoting
137*     factorization of a symmetric indefinite matrix.
138*
139      IF( LSAMEN( 2, C2, 'SY' ) ) THEN
140*
141*        CSYTRF
142*
143         SRNAMT = 'CSYTRF'
144         INFOT = 1
145         CALL CSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
146         CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
147         INFOT = 2
148         CALL CSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
149         CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
150         INFOT = 4
151         CALL CSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
152         CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
153*
154*        CSYTF2
155*
156         SRNAMT = 'CSYTF2'
157         INFOT = 1
158         CALL CSYTF2( '/', 0, A, 1, IP, INFO )
159         CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
160         INFOT = 2
161         CALL CSYTF2( 'U', -1, A, 1, IP, INFO )
162         CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
163         INFOT = 4
164         CALL CSYTF2( 'U', 2, A, 1, IP, INFO )
165         CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
166*
167*        CSYTRI
168*
169         SRNAMT = 'CSYTRI'
170         INFOT = 1
171         CALL CSYTRI( '/', 0, A, 1, IP, W, INFO )
172         CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
173         INFOT = 2
174         CALL CSYTRI( 'U', -1, A, 1, IP, W, INFO )
175         CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
176         INFOT = 4
177         CALL CSYTRI( 'U', 2, A, 1, IP, W, INFO )
178         CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
179*
180*        CSYTRI2
181*
182         SRNAMT = 'CSYTRI2'
183         INFOT = 1
184         CALL CSYTRI2( '/', 0, A, 1, IP, W, 1, INFO )
185         CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
186         INFOT = 2
187         CALL CSYTRI2( 'U', -1, A, 1, IP, W, 1, INFO )
188         CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
189         INFOT = 4
190         CALL CSYTRI2( 'U', 2, A, 1, IP, W, 1, INFO )
191         CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
192*
193*        CSYTRS
194*
195         SRNAMT = 'CSYTRS'
196         INFOT = 1
197         CALL CSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
198         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
199         INFOT = 2
200         CALL CSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
201         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
202         INFOT = 3
203         CALL CSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
204         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
205         INFOT = 5
206         CALL CSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
207         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
208         INFOT = 8
209         CALL CSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
210         CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
211*
212*        CSYRFS
213*
214         SRNAMT = 'CSYRFS'
215         INFOT = 1
216         CALL CSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
217     $                R, INFO )
218         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
219         INFOT = 2
220         CALL CSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
221     $                W, R, INFO )
222         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
223         INFOT = 3
224         CALL CSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
225     $                W, R, INFO )
226         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
227         INFOT = 5
228         CALL CSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
229     $                R, INFO )
230         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
231         INFOT = 7
232         CALL CSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
233     $                R, INFO )
234         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
235         INFOT = 10
236         CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
237     $                R, INFO )
238         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
239         INFOT = 12
240         CALL CSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
241     $                R, INFO )
242         CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
243*
244*        CSYRFSX
245*
246         N_ERR_BNDS = 3
247         NPARAMS = 0
248         SRNAMT = 'CSYRFSX'
249         INFOT = 1
250         CALL CSYRFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
251     $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
252     $        PARAMS, W, R, INFO )
253         CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
254         INFOT = 2
255         CALL CSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
256     $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
257     $        PARAMS, W, R, INFO )
258         CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
259         EQ = 'N'
260         INFOT = 3
261         CALL CSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
262     $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
263     $        PARAMS, W, R, INFO )
264         CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
265         INFOT = 4
266         CALL CSYRFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1,
267     $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
268     $        PARAMS, W, R, INFO )
269         CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
270         INFOT = 6
271         CALL CSYRFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2,
272     $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
273     $        PARAMS, W, R, INFO )
274         CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
275         INFOT = 8
276         CALL CSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2,
277     $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
278     $        PARAMS, W, R, INFO )
279         CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
280         INFOT = 12
281         CALL CSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2,
282     $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
283     $        PARAMS, W, R, INFO )
284         CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
285         INFOT = 14
286         CALL CSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1,
287     $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
288     $        PARAMS, W, R, INFO )
289         CALL CHKXER( 'CSYRFSX', INFOT, NOUT, LERR, OK )
290*
291*        CSYCON
292*
293         SRNAMT = 'CSYCON'
294         INFOT = 1
295         CALL CSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, INFO )
296         CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
297         INFOT = 2
298         CALL CSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, INFO )
299         CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
300         INFOT = 4
301         CALL CSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, INFO )
302         CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
303         INFOT = 6
304         CALL CSYCON( 'U', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
305         CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
306*
307*     Test error exits of the routines that use the diagonal pivoting
308*     factorization of a symmetric indefinite packed matrix.
309*
310      ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
311*
312*        CSPTRF
313*
314         SRNAMT = 'CSPTRF'
315         INFOT = 1
316         CALL CSPTRF( '/', 0, A, IP, INFO )
317         CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK )
318         INFOT = 2
319         CALL CSPTRF( 'U', -1, A, IP, INFO )
320         CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK )
321*
322*        CSPTRI
323*
324         SRNAMT = 'CSPTRI'
325         INFOT = 1
326         CALL CSPTRI( '/', 0, A, IP, W, INFO )
327         CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK )
328         INFOT = 2
329         CALL CSPTRI( 'U', -1, A, IP, W, INFO )
330         CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK )
331*
332*        CSPTRS
333*
334         SRNAMT = 'CSPTRS'
335         INFOT = 1
336         CALL CSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
337         CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
338         INFOT = 2
339         CALL CSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
340         CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
341         INFOT = 3
342         CALL CSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
343         CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
344         INFOT = 7
345         CALL CSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
346         CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
347*
348*        CSPRFS
349*
350         SRNAMT = 'CSPRFS'
351         INFOT = 1
352         CALL CSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
353     $                INFO )
354         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
355         INFOT = 2
356         CALL CSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
357     $                INFO )
358         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
359         INFOT = 3
360         CALL CSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
361     $                INFO )
362         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
363         INFOT = 8
364         CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
365     $                INFO )
366         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
367         INFOT = 10
368         CALL CSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
369     $                INFO )
370         CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
371*
372*        CSPCON
373*
374         SRNAMT = 'CSPCON'
375         INFOT = 1
376         CALL CSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO )
377         CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
378         INFOT = 2
379         CALL CSPCON( 'U', -1, A, IP, ANRM, RCOND, W, INFO )
380         CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
381         INFOT = 5
382         CALL CSPCON( 'U', 1, A, IP, -ANRM, RCOND, W, INFO )
383         CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
384      END IF
385*
386*     Print a summary line.
387*
388      CALL ALAESM( PATH, OK, NOUT )
389*
390      RETURN
391*
392*     End of CERRSY
393*
394      END
395