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