1       SUBROUTINE DERRSY( 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 *  DERRSY tests the error exits for the DOUBLE PRECISION 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 ), IW( NMAX )
 40       DOUBLE PRECISION   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, DSPCON, DSPRFS, DSPTRF, DSPTRI,
 49      $                   DSPTRS, DSYCON, DSYRFS, DSYTF2, DSYTRF, DSYTRI,
 50      $                   DSYTRI2, DSYTRS
 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          DBLE
 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.D0 / DBLE( I+J )
 75             AF( I, J ) = 1.D0 / DBLE( I+J )
 76    10    CONTINUE
 77          B( J ) = 0.D0
 78          R1( J ) = 0.D0
 79          R2( J ) = 0.D0
 80          W( J ) = 0.D0
 81          X( J ) = 0.D0
 82          IP( J ) = J
 83          IW( J ) = J
 84    20 CONTINUE
 85       ANRM = 1.0D0
 86       RCOND = 1.0D0
 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 *        DSYTRF
 95 *
 96          SRNAMT = 'DSYTRF'
 97          INFOT = 1
 98          CALL DSYTRF( '/'0, A, 1, IP, W, 1, INFO )
 99          CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
100          INFOT = 2
101          CALL DSYTRF( 'U'-1, A, 1, IP, W, 1, INFO )
102          CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
103          INFOT = 4
104          CALL DSYTRF( 'U'2, A, 1, IP, W, 4, INFO )
105          CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
106 *
107 *        DSYTF2
108 *
109          SRNAMT = 'DSYTF2'
110          INFOT = 1
111          CALL DSYTF2( '/'0, A, 1, IP, INFO )
112          CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK )
113          INFOT = 2
114          CALL DSYTF2( 'U'-1, A, 1, IP, INFO )
115          CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK )
116          INFOT = 4
117          CALL DSYTF2( 'U'2, A, 1, IP, INFO )
118          CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK )
119 *
120 *        DSYTRI
121 *
122          SRNAMT = 'DSYTRI'
123          INFOT = 1
124          CALL DSYTRI( '/'0, A, 1, IP, W, INFO )
125          CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK )
126          INFOT = 2
127          CALL DSYTRI( 'U'-1, A, 1, IP, W, INFO )
128          CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK )
129          INFOT = 4
130          CALL DSYTRI( 'U'2, A, 1, IP, W, INFO )
131          CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK )
132 *
133 *        DSYTRI2
134 *
135          SRNAMT = 'DSYTRI2'
136          INFOT = 1
137          CALL DSYTRI2( '/'0, A, 1, IP, W, IW, INFO )
138          CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
139          INFOT = 2
140          CALL DSYTRI2( 'U'-1, A, 1, IP, W, IW, INFO )
141          CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
142          INFOT = 4
143          CALL DSYTRI2( 'U'2, A, 1, IP, W, IW, INFO )
144          CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
145 *
146 *        DSYTRS
147 *
148          SRNAMT = 'DSYTRS'
149          INFOT = 1
150          CALL DSYTRS( '/'00, A, 1, IP, B, 1, INFO )
151          CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
152          INFOT = 2
153          CALL DSYTRS( 'U'-10, A, 1, IP, B, 1, INFO )
154          CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
155          INFOT = 3
156          CALL DSYTRS( 'U'0-1, A, 1, IP, B, 1, INFO )
157          CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
158          INFOT = 5
159          CALL DSYTRS( 'U'21, A, 1, IP, B, 2, INFO )
160          CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
161          INFOT = 8
162          CALL DSYTRS( 'U'21, A, 2, IP, B, 1, INFO )
163          CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
164 *
165 *        DSYRFS
166 *
167          SRNAMT = 'DSYRFS'
168          INFOT = 1
169          CALL DSYRFS( '/'00, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
170      $                IW, INFO )
171          CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
172          INFOT = 2
173          CALL DSYRFS( 'U'-10, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
174      $                W, IW, INFO )
175          CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
176          INFOT = 3
177          CALL DSYRFS( 'U'0-1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
178      $                W, IW, INFO )
179          CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
180          INFOT = 5
181          CALL DSYRFS( 'U'21, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
182      $                IW, INFO )
183          CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
184          INFOT = 7
185          CALL DSYRFS( 'U'21, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
186      $                IW, INFO )
187          CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
188          INFOT = 10
189          CALL DSYRFS( 'U'21, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
190      $                IW, INFO )
191          CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
192          INFOT = 12
193          CALL DSYRFS( 'U'21, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
194      $                IW, INFO )
195          CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
196 *
197 *        DSYCON
198 *
199          SRNAMT = 'DSYCON'
200          INFOT = 1
201          CALL DSYCON( '/'0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
202          CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK )
203          INFOT = 2
204          CALL DSYCON( 'U'-1, A, 1, IP, ANRM, RCOND, W, IW, INFO )
205          CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK )
206          INFOT = 4
207          CALL DSYCON( 'U'2, A, 1, IP, ANRM, RCOND, W, IW, INFO )
208          CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK )
209          INFOT = 6
210          CALL DSYCON( 'U'1, A, 1, IP, -1.0D0, RCOND, W, IW, INFO )
211          CALL CHKXER( 'DSYCON', 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 *        DSPTRF
219 *
220          SRNAMT = 'DSPTRF'
221          INFOT = 1
222          CALL DSPTRF( '/'0, A, IP, INFO )
223          CALL CHKXER( 'DSPTRF', INFOT, NOUT, LERR, OK )
224          INFOT = 2
225          CALL DSPTRF( 'U'-1, A, IP, INFO )
226          CALL CHKXER( 'DSPTRF', INFOT, NOUT, LERR, OK )
227 *
228 *        DSPTRI
229 *
230          SRNAMT = 'DSPTRI'
231          INFOT = 1
232          CALL DSPTRI( '/'0, A, IP, W, INFO )
233          CALL CHKXER( 'DSPTRI', INFOT, NOUT, LERR, OK )
234          INFOT = 2
235          CALL DSPTRI( 'U'-1, A, IP, W, INFO )
236          CALL CHKXER( 'DSPTRI', INFOT, NOUT, LERR, OK )
237 *
238 *        DSPTRS
239 *
240          SRNAMT = 'DSPTRS'
241          INFOT = 1
242          CALL DSPTRS( '/'00, A, IP, B, 1, INFO )
243          CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
244          INFOT = 2
245          CALL DSPTRS( 'U'-10, A, IP, B, 1, INFO )
246          CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
247          INFOT = 3
248          CALL DSPTRS( 'U'0-1, A, IP, B, 1, INFO )
249          CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
250          INFOT = 7
251          CALL DSPTRS( 'U'21, A, IP, B, 1, INFO )
252          CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
253 *
254 *        DSPRFS
255 *
256          SRNAMT = 'DSPRFS'
257          INFOT = 1
258          CALL DSPRFS( '/'00, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
259      $                INFO )
260          CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
261          INFOT = 2
262          CALL DSPRFS( 'U'-10, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
263      $                INFO )
264          CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
265          INFOT = 3
266          CALL DSPRFS( 'U'0-1, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
267      $                INFO )
268          CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
269          INFOT = 8
270          CALL DSPRFS( 'U'21, A, AF, IP, B, 1, X, 2, R1, R2, W, IW,
271      $                INFO )
272          CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
273          INFOT = 10
274          CALL DSPRFS( 'U'21, A, AF, IP, B, 2, X, 1, R1, R2, W, IW,
275      $                INFO )
276          CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
277 *
278 *        DSPCON
279 *
280          SRNAMT = 'DSPCON'
281          INFOT = 1
282          CALL DSPCON( '/'0, A, IP, ANRM, RCOND, W, IW, INFO )
283          CALL CHKXER( 'DSPCON', INFOT, NOUT, LERR, OK )
284          INFOT = 2
285          CALL DSPCON( 'U'-1, A, IP, ANRM, RCOND, W, IW, INFO )
286          CALL CHKXER( 'DSPCON', INFOT, NOUT, LERR, OK )
287          INFOT = 5
288          CALL DSPCON( 'U'1, A, IP, -1.0D0, RCOND, W, IW, INFO )
289          CALL CHKXER( 'DSPCON', 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 DERRSY
299 *
300       END