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