1       SUBROUTINE ZERRSY( PATH, NUNIT )
  2 *
  3 *  -- LAPACK test routine (version 3.2) --
  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 *  ZERRSY tests the error exits for the COMPLEX*16 routines
 16 *  for symmetric indefinite matrices.
 17 *
 18 *  Note that this file is used only when the XBLAS are available,
 19 *  otherwise zerrsy.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       DOUBLE PRECISION   ANRM, RCOND, BERR
 41 *     ..
 42 *     .. Local Arrays ..
 43       INTEGER            IP( NMAX )
 44       DOUBLE PRECISION   R( NMAX ), R1( NMAX ), R2( NMAX ),
 45      $                   S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
 46      $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
 47       COMPLEX*16         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, ZSPCON, ZSPRFS, ZSPTRF, ZSPTRI,
 56      $                   ZSPTRS, ZSYCON, ZSYRFS, ZSYTF2, ZSYTRF, ZSYTRI,
 57      $                   ZSYTRI2, ZSYTRS, ZSYRFSX
 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          DBLEDCMPLX
 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 ) = DCMPLX1.D0 / DBLE( I+J ),
 82      $                  -1.D0 / DBLE( I+J ) )
 83             AF( I, J ) = DCMPLX1.D0 / DBLE( I+J ),
 84      $                   -1.D0 / DBLE( I+J ) )
 85    10    CONTINUE
 86          B( J ) = 0.D0
 87          R1( J ) = 0.D0
 88          R2( J ) = 0.D0
 89          W( J ) = 0.D0
 90          X( J ) = 0.D0
 91          S( J ) = 0.D0
 92          IP( J ) = J
 93    20 CONTINUE
 94       ANRM = 1.0D0
 95       OK = .TRUE.
 96 *
 97 *     Test error exits of the routines that use the diagonal pivoting
 98 *     factorization of a symmetric indefinite matrix.
 99 *
100       IF( LSAMEN( 2, C2, 'SY' ) ) THEN
101 *
102 *        ZSYTRF
103 *
104          SRNAMT = 'ZSYTRF'
105          INFOT = 1
106          CALL ZSYTRF( '/'0, A, 1, IP, W, 1, INFO )
107          CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
108          INFOT = 2
109          CALL ZSYTRF( 'U'-1, A, 1, IP, W, 1, INFO )
110          CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
111          INFOT = 4
112          CALL ZSYTRF( 'U'2, A, 1, IP, W, 4, INFO )
113          CALL CHKXER( 'ZSYTRF', INFOT, NOUT, LERR, OK )
114 *
115 *        ZSYTF2
116 *
117          SRNAMT = 'ZSYTF2'
118          INFOT = 1
119          CALL ZSYTF2( '/'0, A, 1, IP, INFO )
120          CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK )
121          INFOT = 2
122          CALL ZSYTF2( 'U'-1, A, 1, IP, INFO )
123          CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK )
124          INFOT = 4
125          CALL ZSYTF2( 'U'2, A, 1, IP, INFO )
126          CALL CHKXER( 'ZSYTF2', INFOT, NOUT, LERR, OK )
127 *
128 *        ZSYTRI
129 *
130          SRNAMT = 'ZSYTRI'
131          INFOT = 1
132          CALL ZSYTRI( '/'0, A, 1, IP, W, INFO )
133          CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK )
134          INFOT = 2
135          CALL ZSYTRI( 'U'-1, A, 1, IP, W, INFO )
136          CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK )
137          INFOT = 4
138          CALL ZSYTRI( 'U'2, A, 1, IP, W, INFO )
139          CALL CHKXER( 'ZSYTRI', INFOT, NOUT, LERR, OK )
140 *
141 *        ZSYTRI2
142 *
143          SRNAMT = 'ZSYTRI2'
144          INFOT = 1
145          CALL ZSYTRI2( '/'0, A, 1, IP, W, 1, INFO )
146          CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK )
147          INFOT = 2
148          CALL ZSYTRI2( 'U'-1, A, 1, IP, W, 1, INFO )
149          CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK )
150          INFOT = 4
151          CALL ZSYTRI2( 'U'2, A, 1, IP, W, 1, INFO )
152          CALL CHKXER( 'ZSYTRI2', INFOT, NOUT, LERR, OK )
153 *
154 *        ZSYTRS
155 *
156          SRNAMT = 'ZSYTRS'
157          INFOT = 1
158          CALL ZSYTRS( '/'00, A, 1, IP, B, 1, INFO )
159          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
160          INFOT = 2
161          CALL ZSYTRS( 'U'-10, A, 1, IP, B, 1, INFO )
162          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
163          INFOT = 3
164          CALL ZSYTRS( 'U'0-1, A, 1, IP, B, 1, INFO )
165          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
166          INFOT = 5
167          CALL ZSYTRS( 'U'21, A, 1, IP, B, 2, INFO )
168          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
169          INFOT = 8
170          CALL ZSYTRS( 'U'21, A, 2, IP, B, 1, INFO )
171          CALL CHKXER( 'ZSYTRS', INFOT, NOUT, LERR, OK )
172 *
173 *        ZSYRFS
174 *
175          SRNAMT = 'ZSYRFS'
176          INFOT = 1
177          CALL ZSYRFS( '/'00, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
178      $                R, INFO )
179          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
180          INFOT = 2
181          CALL ZSYRFS( 'U'-10, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
182      $                W, R, INFO )
183          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
184          INFOT = 3
185          CALL ZSYRFS( 'U'0-1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
186      $                W, R, INFO )
187          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
188          INFOT = 5
189          CALL ZSYRFS( 'U'21, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
190      $                R, INFO )
191          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
192          INFOT = 7
193          CALL ZSYRFS( 'U'21, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
194      $                R, INFO )
195          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
196          INFOT = 10
197          CALL ZSYRFS( 'U'21, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
198      $                R, INFO )
199          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
200          INFOT = 12
201          CALL ZSYRFS( 'U'21, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
202      $                R, INFO )
203          CALL CHKXER( 'ZSYRFS', INFOT, NOUT, LERR, OK )
204 *
205 *        ZSYRFSX
206 *
207          N_ERR_BNDS = 3
208          NPARAMS = 0
209          SRNAMT = 'ZSYRFSX'
210          INFOT = 1
211          CALL ZSYRFSX( '/', EQ, 00, A, 1, AF, 1, IP, S, B, 1, X, 1,
212      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
213      $        PARAMS, W, R, INFO )
214          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
215          INFOT = 2
216          CALL ZSYRFSX( 'U', EQ, -10, A, 1, AF, 1, IP, S, B, 1, X, 1,
217      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
218      $        PARAMS, W, R, INFO )
219          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
220          EQ = 'N'
221          INFOT = 3
222          CALL ZSYRFSX( 'U', EQ, -10, A, 1, AF, 1, IP, S, B, 1, X, 1,
223      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
224      $        PARAMS, W, R, INFO )
225          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
226          INFOT = 4
227          CALL ZSYRFSX( 'U', EQ, 0-1, A, 1, AF, 1, IP, S, B, 1, X, 1,
228      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
229      $        PARAMS, W, R, INFO )
230          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
231          INFOT = 6
232          CALL ZSYRFSX( 'U', EQ, 21, A, 1, AF, 2, IP, S, B, 2, X, 2,
233      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
234      $        PARAMS, W, R, INFO )
235          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
236          INFOT = 8
237          CALL ZSYRFSX( 'U', EQ, 21, A, 2, AF, 1, IP, S, B, 2, X, 2,
238      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
239      $        PARAMS, W, R, INFO )
240          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
241          INFOT = 11
242          CALL ZSYRFSX( 'U', EQ, 21, A, 2, AF, 2, IP, S, B, 1, X, 2,
243      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
244      $        PARAMS, W, R, INFO )
245          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
246          INFOT = 13
247          CALL ZSYRFSX( 'U', EQ, 21, A, 2, AF, 2, IP, S, B, 2, X, 1,
248      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
249      $        PARAMS, W, R, INFO )
250          CALL CHKXER( 'ZSYRFSX', INFOT, NOUT, LERR, OK )
251 *
252 *        ZSYCON
253 *
254          SRNAMT = 'ZSYCON'
255          INFOT = 1
256          CALL ZSYCON( '/'0, A, 1, IP, ANRM, RCOND, W, INFO )
257          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
258          INFOT = 2
259          CALL ZSYCON( 'U'-1, A, 1, IP, ANRM, RCOND, W, INFO )
260          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
261          INFOT = 4
262          CALL ZSYCON( 'U'2, A, 1, IP, ANRM, RCOND, W, INFO )
263          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
264          INFOT = 6
265          CALL ZSYCON( 'U'1, A, 1, IP, -ANRM, RCOND, W, INFO )
266          CALL CHKXER( 'ZSYCON', INFOT, NOUT, LERR, OK )
267 *
268 *     Test error exits of the routines that use the diagonal pivoting
269 *     factorization of a symmetric indefinite packed matrix.
270 *
271       ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
272 *
273 *        ZSPTRF
274 *
275          SRNAMT = 'ZSPTRF'
276          INFOT = 1
277          CALL ZSPTRF( '/'0, A, IP, INFO )
278          CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK )
279          INFOT = 2
280          CALL ZSPTRF( 'U'-1, A, IP, INFO )
281          CALL CHKXER( 'ZSPTRF', INFOT, NOUT, LERR, OK )
282 *
283 *        ZSPTRI
284 *
285          SRNAMT = 'ZSPTRI'
286          INFOT = 1
287          CALL ZSPTRI( '/'0, A, IP, W, INFO )
288          CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK )
289          INFOT = 2
290          CALL ZSPTRI( 'U'-1, A, IP, W, INFO )
291          CALL CHKXER( 'ZSPTRI', INFOT, NOUT, LERR, OK )
292 *
293 *        ZSPTRS
294 *
295          SRNAMT = 'ZSPTRS'
296          INFOT = 1
297          CALL ZSPTRS( '/'00, A, IP, B, 1, INFO )
298          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
299          INFOT = 2
300          CALL ZSPTRS( 'U'-10, A, IP, B, 1, INFO )
301          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
302          INFOT = 3
303          CALL ZSPTRS( 'U'0-1, A, IP, B, 1, INFO )
304          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
305          INFOT = 7
306          CALL ZSPTRS( 'U'21, A, IP, B, 1, INFO )
307          CALL CHKXER( 'ZSPTRS', INFOT, NOUT, LERR, OK )
308 *
309 *        ZSPRFS
310 *
311          SRNAMT = 'ZSPRFS'
312          INFOT = 1
313          CALL ZSPRFS( '/'00, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
314      $                INFO )
315          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
316          INFOT = 2
317          CALL ZSPRFS( 'U'-10, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
318      $                INFO )
319          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
320          INFOT = 3
321          CALL ZSPRFS( 'U'0-1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
322      $                INFO )
323          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
324          INFOT = 8
325          CALL ZSPRFS( 'U'21, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
326      $                INFO )
327          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
328          INFOT = 10
329          CALL ZSPRFS( 'U'21, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
330      $                INFO )
331          CALL CHKXER( 'ZSPRFS', INFOT, NOUT, LERR, OK )
332 *
333 *        ZSPCON
334 *
335          SRNAMT = 'ZSPCON'
336          INFOT = 1
337          CALL ZSPCON( '/'0, A, IP, ANRM, RCOND, W, INFO )
338          CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK )
339          INFOT = 2
340          CALL ZSPCON( 'U'-1, A, IP, ANRM, RCOND, W, INFO )
341          CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK )
342          INFOT = 5
343          CALL ZSPCON( 'U'1, A, IP, -ANRM, RCOND, W, INFO )
344          CALL CHKXER( 'ZSPCON', INFOT, NOUT, LERR, OK )
345       END IF
346 *
347 *     Print a summary line.
348 *
349       CALL ALAESM( PATH, OK, NOUT )
350 *
351       RETURN
352 *
353 *     End of ZERRSY
354 *
355       END