1       SUBROUTINE CERRSY( 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 *  CERRSY tests the error exits for the COMPLEX routines
 16 *  for symmetric indefinite 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       REAL               ANRM, RCOND
 37 *     ..
 38 *     .. Local Arrays ..
 39       INTEGER            IP( NMAX )
 40       REAL               R( NMAX ), R1( NMAX ), R2( NMAX )
 41       COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
 42      $                   W( 2*NMAX ), X( NMAX )
 43 *     ..
 44 *     .. External Functions ..
 45       LOGICAL            LSAMEN
 46       EXTERNAL           LSAMEN
 47 *     ..
 48 *     .. External Subroutines ..
 49       EXTERNAL           ALAESM, CHKXER, CSPCON, CSPRFS, CSPTRF, CSPTRI,
 50      $                   CSPTRS, CSYCON, CSYRFS, CSYTF2, CSYTRF, CSYTRI,
 51      $                   CSYTRI2, CSYTRS
 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          CMPLX, REAL
 64 *     ..
 65 *     .. Executable Statements ..
 66 *
 67       NOUT = NUNIT
 68       WRITE( NOUT, FMT = * )
 69       C2 = PATH( 23 )
 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 ) = CMPLX1/ REAL( I+J ), -1/ REAL( I+J ) )
 76             AF( I, J ) = CMPLX1/ REAL( I+J ), -1/ REAL( I+J ) )
 77    10    CONTINUE
 78          B( J ) = 0.
 79          R1( J ) = 0.
 80          R2( J ) = 0.
 81          W( J ) = 0.
 82          X( J ) = 0.
 83          IP( J ) = J
 84    20 CONTINUE
 85       ANRM = 1.0
 86       OK = .TRUE.
 87 *
 88 *     Test error exits of the routines that use the diagonal pivoting
 89 *     factorization of a symmetric indefinite matrix.
 90 *
 91       IF( LSAMEN( 2, C2, 'SY' ) ) THEN
 92 *
 93 *        CSYTRF
 94 *
 95          SRNAMT = 'CSYTRF'
 96          INFOT = 1
 97          CALL CSYTRF( '/'0, A, 1, IP, W, 1, INFO )
 98          CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
 99          INFOT = 2
100          CALL CSYTRF( 'U'-1, A, 1, IP, W, 1, INFO )
101          CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
102          INFOT = 4
103          CALL CSYTRF( 'U'2, A, 1, IP, W, 4, INFO )
104          CALL CHKXER( 'CSYTRF', INFOT, NOUT, LERR, OK )
105 *
106 *        CSYTF2
107 *
108          SRNAMT = 'CSYTF2'
109          INFOT = 1
110          CALL CSYTF2( '/'0, A, 1, IP, INFO )
111          CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
112          INFOT = 2
113          CALL CSYTF2( 'U'-1, A, 1, IP, INFO )
114          CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
115          INFOT = 4
116          CALL CSYTF2( 'U'2, A, 1, IP, INFO )
117          CALL CHKXER( 'CSYTF2', INFOT, NOUT, LERR, OK )
118 *
119 *        CSYTRI
120 *
121          SRNAMT = 'CSYTRI'
122          INFOT = 1
123          CALL CSYTRI( '/'0, A, 1, IP, W, INFO )
124          CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
125          INFOT = 2
126          CALL CSYTRI( 'U'-1, A, 1, IP, W, INFO )
127          CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
128          INFOT = 4
129          CALL CSYTRI( 'U'2, A, 1, IP, W, INFO )
130          CALL CHKXER( 'CSYTRI', INFOT, NOUT, LERR, OK )
131 *
132 *        CSYTRI2
133 *
134          SRNAMT = 'CSYTRI2'
135          INFOT = 1
136          CALL CSYTRI2( '/'0, A, 1, IP, W, 1, INFO )
137          CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
138          INFOT = 2
139          CALL CSYTRI2( 'U'-1, A, 1, IP, W, 1, INFO )
140          CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
141          INFOT = 4
142          CALL CSYTRI2( 'U'2, A, 1, IP, W, 1, INFO )
143          CALL CHKXER( 'CSYTRI2', INFOT, NOUT, LERR, OK )
144 *
145 *        CSYTRS
146 *
147          SRNAMT = 'CSYTRS'
148          INFOT = 1
149          CALL CSYTRS( '/'00, A, 1, IP, B, 1, INFO )
150          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
151          INFOT = 2
152          CALL CSYTRS( 'U'-10, A, 1, IP, B, 1, INFO )
153          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
154          INFOT = 3
155          CALL CSYTRS( 'U'0-1, A, 1, IP, B, 1, INFO )
156          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
157          INFOT = 5
158          CALL CSYTRS( 'U'21, A, 1, IP, B, 2, INFO )
159          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
160          INFOT = 8
161          CALL CSYTRS( 'U'21, A, 2, IP, B, 1, INFO )
162          CALL CHKXER( 'CSYTRS', INFOT, NOUT, LERR, OK )
163 *
164 *        CSYRFS
165 *
166          SRNAMT = 'CSYRFS'
167          INFOT = 1
168          CALL CSYRFS( '/'00, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
169      $                R, INFO )
170          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
171          INFOT = 2
172          CALL CSYRFS( 'U'-10, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
173      $                W, R, INFO )
174          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
175          INFOT = 3
176          CALL CSYRFS( 'U'0-1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
177      $                W, R, INFO )
178          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
179          INFOT = 5
180          CALL CSYRFS( 'U'21, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
181      $                R, INFO )
182          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
183          INFOT = 7
184          CALL CSYRFS( 'U'21, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
185      $                R, INFO )
186          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
187          INFOT = 10
188          CALL CSYRFS( 'U'21, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
189      $                R, INFO )
190          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
191          INFOT = 12
192          CALL CSYRFS( 'U'21, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
193      $                R, INFO )
194          CALL CHKXER( 'CSYRFS', INFOT, NOUT, LERR, OK )
195 *
196 *        CSYCON
197 *
198          SRNAMT = 'CSYCON'
199          INFOT = 1
200          CALL CSYCON( '/'0, A, 1, IP, ANRM, RCOND, W, INFO )
201          CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
202          INFOT = 2
203          CALL CSYCON( 'U'-1, A, 1, IP, ANRM, RCOND, W, INFO )
204          CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
205          INFOT = 4
206          CALL CSYCON( 'U'2, A, 1, IP, ANRM, RCOND, W, INFO )
207          CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
208          INFOT = 6
209          CALL CSYCON( 'U'1, A, 1, IP, -ANRM, RCOND, W, INFO )
210          CALL CHKXER( 'CSYCON', INFOT, NOUT, LERR, OK )
211 *
212 *     Test error exits of the routines that use the diagonal pivoting
213 *     factorization of a symmetric indefinite packed matrix.
214 *
215       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
216 *
217 *        CSPTRF
218 *
219          SRNAMT = 'CSPTRF'
220          INFOT = 1
221          CALL CSPTRF( '/'0, A, IP, INFO )
222          CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK )
223          INFOT = 2
224          CALL CSPTRF( 'U'-1, A, IP, INFO )
225          CALL CHKXER( 'CSPTRF', INFOT, NOUT, LERR, OK )
226 *
227 *        CSPTRI
228 *
229          SRNAMT = 'CSPTRI'
230          INFOT = 1
231          CALL CSPTRI( '/'0, A, IP, W, INFO )
232          CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK )
233          INFOT = 2
234          CALL CSPTRI( 'U'-1, A, IP, W, INFO )
235          CALL CHKXER( 'CSPTRI', INFOT, NOUT, LERR, OK )
236 *
237 *        CSPTRS
238 *
239          SRNAMT = 'CSPTRS'
240          INFOT = 1
241          CALL CSPTRS( '/'00, A, IP, B, 1, INFO )
242          CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
243          INFOT = 2
244          CALL CSPTRS( 'U'-10, A, IP, B, 1, INFO )
245          CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
246          INFOT = 3
247          CALL CSPTRS( 'U'0-1, A, IP, B, 1, INFO )
248          CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
249          INFOT = 7
250          CALL CSPTRS( 'U'21, A, IP, B, 1, INFO )
251          CALL CHKXER( 'CSPTRS', INFOT, NOUT, LERR, OK )
252 *
253 *        CSPRFS
254 *
255          SRNAMT = 'CSPRFS'
256          INFOT = 1
257          CALL CSPRFS( '/'00, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
258      $                INFO )
259          CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
260          INFOT = 2
261          CALL CSPRFS( 'U'-10, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
262      $                INFO )
263          CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
264          INFOT = 3
265          CALL CSPRFS( 'U'0-1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
266      $                INFO )
267          CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
268          INFOT = 8
269          CALL CSPRFS( 'U'21, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
270      $                INFO )
271          CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
272          INFOT = 10
273          CALL CSPRFS( 'U'21, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
274      $                INFO )
275          CALL CHKXER( 'CSPRFS', INFOT, NOUT, LERR, OK )
276 *
277 *        CSPCON
278 *
279          SRNAMT = 'CSPCON'
280          INFOT = 1
281          CALL CSPCON( '/'0, A, IP, ANRM, RCOND, W, INFO )
282          CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
283          INFOT = 2
284          CALL CSPCON( 'U'-1, A, IP, ANRM, RCOND, W, INFO )
285          CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
286          INFOT = 5
287          CALL CSPCON( 'U'1, A, IP, -ANRM, RCOND, W, INFO )
288          CALL CHKXER( 'CSPCON', INFOT, NOUT, LERR, OK )
289       END IF
290 *
291 *     Print a summary line.
292 *
293       CALL ALAESM( PATH, OK, NOUT )
294 *
295       RETURN
296 *
297 *     End of CERRSY
298 *
299       END