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