1*> \brief \b DERRSY
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE DERRSY( PATH, NUNIT )
12*
13*       .. Scalar Arguments ..
14*       CHARACTER*3        PATH
15*       INTEGER            NUNIT
16*       ..
17*
18*
19*> \par Purpose:
20*  =============
21*>
22*> \verbatim
23*>
24*> DERRSY tests the error exits for the DOUBLE PRECISION routines
25*> for symmetric indefinite matrices.
26*> \endverbatim
27*
28*  Arguments:
29*  ==========
30*
31*> \param[in] PATH
32*> \verbatim
33*>          PATH is CHARACTER*3
34*>          The LAPACK path name for the routines to be tested.
35*> \endverbatim
36*>
37*> \param[in] NUNIT
38*> \verbatim
39*>          NUNIT is INTEGER
40*>          The unit number for output.
41*> \endverbatim
42*
43*  Authors:
44*  ========
45*
46*> \author Univ. of Tennessee
47*> \author Univ. of California Berkeley
48*> \author Univ. of Colorado Denver
49*> \author NAG Ltd.
50*
51*> \date November 2015
52*
53*> \ingroup double_lin
54*
55*  =====================================================================
56      SUBROUTINE DERRSY( PATH, NUNIT )
57*
58*  -- LAPACK test routine (version 3.6.0) --
59*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
60*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61*     November 2015
62*
63*     .. Scalar Arguments ..
64      CHARACTER*3        PATH
65      INTEGER            NUNIT
66*     ..
67*
68*  =====================================================================
69*
70*     .. Parameters ..
71      INTEGER            NMAX
72      PARAMETER          ( NMAX = 4 )
73*     ..
74*     .. Local Scalars ..
75      CHARACTER*2        C2
76      INTEGER            I, INFO, J
77      DOUBLE PRECISION   ANRM, RCOND
78*     ..
79*     .. Local Arrays ..
80      INTEGER            IP( NMAX ), IW( NMAX )
81      DOUBLE PRECISION   A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
82     $                   R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX )
83*     ..
84*     .. External Functions ..
85      LOGICAL            LSAMEN
86      EXTERNAL           LSAMEN
87*     ..
88*     .. External Subroutines ..
89      EXTERNAL           ALAESM, CHKXER, DSPCON, DSPRFS, DSPTRF, DSPTRI,
90     $                   DSPTRS, DSYCON, DSYCON_ROOK, DSYRFS, DSYTF2,
91     $                   DSYTF2_ROOK, DSYTRF, DSYTRF_ROOK, DSYTRI,
92     $                   DSYTRI_ROOK, DSYTRI2, DSYTRS, DSYTRS_ROOK
93*     ..
94*     .. Scalars in Common ..
95      LOGICAL            LERR, OK
96      CHARACTER*32       SRNAMT
97      INTEGER            INFOT, NOUT
98*     ..
99*     .. Common blocks ..
100      COMMON             / INFOC / INFOT, NOUT, OK, LERR
101      COMMON             / SRNAMC / SRNAMT
102*     ..
103*     .. Intrinsic Functions ..
104      INTRINSIC          DBLE
105*     ..
106*     .. Executable Statements ..
107*
108      NOUT = NUNIT
109      WRITE( NOUT, FMT = * )
110      C2 = PATH( 2: 3 )
111*
112*     Set the variables to innocuous values.
113*
114      DO 20 J = 1, NMAX
115         DO 10 I = 1, NMAX
116            A( I, J ) = 1.D0 / DBLE( I+J )
117            AF( I, J ) = 1.D0 / DBLE( I+J )
118   10    CONTINUE
119         B( J ) = 0.D0
120         R1( J ) = 0.D0
121         R2( J ) = 0.D0
122         W( J ) = 0.D0
123         X( J ) = 0.D0
124         IP( J ) = J
125         IW( J ) = J
126   20 CONTINUE
127      ANRM = 1.0D0
128      RCOND = 1.0D0
129      OK = .TRUE.
130*
131      IF( LSAMEN( 2, C2, 'SY' ) ) THEN
132*
133*        Test error exits of the routines that use factorization
134*        of a symmetric indefinite matrix with patrial
135*        (Bunch-Kaufman) pivoting.
136*
137*        DSYTRF
138*
139         SRNAMT = 'DSYTRF'
140         INFOT = 1
141         CALL DSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
142         CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
143         INFOT = 2
144         CALL DSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
145         CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
146         INFOT = 4
147         CALL DSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
148         CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
149*
150*        DSYTF2
151*
152         SRNAMT = 'DSYTF2'
153         INFOT = 1
154         CALL DSYTF2( '/', 0, A, 1, IP, INFO )
155         CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK )
156         INFOT = 2
157         CALL DSYTF2( 'U', -1, A, 1, IP, INFO )
158         CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK )
159         INFOT = 4
160         CALL DSYTF2( 'U', 2, A, 1, IP, INFO )
161         CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK )
162*
163*        DSYTRI
164*
165         SRNAMT = 'DSYTRI'
166         INFOT = 1
167         CALL DSYTRI( '/', 0, A, 1, IP, W, INFO )
168         CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK )
169         INFOT = 2
170         CALL DSYTRI( 'U', -1, A, 1, IP, W, INFO )
171         CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK )
172         INFOT = 4
173         CALL DSYTRI( 'U', 2, A, 1, IP, W, INFO )
174         CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK )
175*
176*        DSYTRI2
177*
178         SRNAMT = 'DSYTRI2'
179         INFOT = 1
180         CALL DSYTRI2( '/', 0, A, 1, IP, W, IW(1), INFO )
181         CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
182         INFOT = 2
183         CALL DSYTRI2( 'U', -1, A, 1, IP, W, IW(1), INFO )
184         CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
185         INFOT = 4
186         CALL DSYTRI2( 'U', 2, A, 1, IP, W, IW(1), INFO )
187         CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
188*
189*        DSYTRS
190*
191         SRNAMT = 'DSYTRS'
192         INFOT = 1
193         CALL DSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
194         CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
195         INFOT = 2
196         CALL DSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
197         CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
198         INFOT = 3
199         CALL DSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
200         CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
201         INFOT = 5
202         CALL DSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
203         CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
204         INFOT = 8
205         CALL DSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
206         CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
207*
208*        DSYRFS
209*
210         SRNAMT = 'DSYRFS'
211         INFOT = 1
212         CALL DSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
213     $                IW, INFO )
214         CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
215         INFOT = 2
216         CALL DSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
217     $                W, IW, INFO )
218         CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
219         INFOT = 3
220         CALL DSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
221     $                W, IW, INFO )
222         CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
223         INFOT = 5
224         CALL DSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
225     $                IW, INFO )
226         CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
227         INFOT = 7
228         CALL DSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
229     $                IW, INFO )
230         CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
231         INFOT = 10
232         CALL DSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
233     $                IW, INFO )
234         CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
235         INFOT = 12
236         CALL DSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
237     $                IW, INFO )
238         CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
239*
240*        DSYCON
241*
242         SRNAMT = 'DSYCON'
243         INFOT = 1
244         CALL DSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
245         CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK )
246         INFOT = 2
247         CALL DSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, IW, INFO )
248         CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK )
249         INFOT = 4
250         CALL DSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, IW, INFO )
251         CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK )
252         INFOT = 6
253         CALL DSYCON( 'U', 1, A, 1, IP, -1.0D0, RCOND, W, IW, INFO )
254         CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK )
255*
256      ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
257*
258*        Test error exits of the routines that use factorization
259*        of a symmetric indefinite matrix with rook
260*        (bounded Bunch-Kaufman) pivoting.
261*
262*        DSYTRF_ROOK
263*
264         SRNAMT = 'DSYTRF_ROOK'
265         INFOT = 1
266         CALL DSYTRF_ROOK( '/', 0, A, 1, IP, W, 1, INFO )
267         CALL CHKXER( 'DSYTRF_ROOK', INFOT, NOUT, LERR, OK )
268         INFOT = 2
269         CALL DSYTRF_ROOK( 'U', -1, A, 1, IP, W, 1, INFO )
270         CALL CHKXER( 'DSYTRF_ROOK', INFOT, NOUT, LERR, OK )
271         INFOT = 4
272         CALL DSYTRF_ROOK( 'U', 2, A, 1, IP, W, 4, INFO )
273         CALL CHKXER( 'DSYTRF_ROOK', INFOT, NOUT, LERR, OK )
274*
275*        DSYTF2_ROOK
276*
277         SRNAMT = 'DSYTF2_ROOK'
278         INFOT = 1
279         CALL DSYTF2_ROOK( '/', 0, A, 1, IP, INFO )
280         CALL CHKXER( 'DSYTF2_ROOK', INFOT, NOUT, LERR, OK )
281         INFOT = 2
282         CALL DSYTF2_ROOK( 'U', -1, A, 1, IP, INFO )
283         CALL CHKXER( 'DSYTF2_ROOK', INFOT, NOUT, LERR, OK )
284         INFOT = 4
285         CALL DSYTF2_ROOK( 'U', 2, A, 1, IP, INFO )
286         CALL CHKXER( 'DSYTF2_ROOK', INFOT, NOUT, LERR, OK )
287*
288*        DSYTRI_ROOK
289*
290         SRNAMT = 'DSYTRI_ROOK'
291         INFOT = 1
292         CALL DSYTRI_ROOK( '/', 0, A, 1, IP, W, INFO )
293         CALL CHKXER( 'DSYTRI_ROOK', INFOT, NOUT, LERR, OK )
294         INFOT = 2
295         CALL DSYTRI_ROOK( 'U', -1, A, 1, IP, W, INFO )
296         CALL CHKXER( 'DSYTRI_ROOK', INFOT, NOUT, LERR, OK )
297         INFOT = 4
298         CALL DSYTRI_ROOK( 'U', 2, A, 1, IP, W, INFO )
299         CALL CHKXER( 'DSYTRI_ROOK', INFOT, NOUT, LERR, OK )
300*
301*        DSYTRS_ROOK
302*
303         SRNAMT = 'DSYTRS_ROOK'
304         INFOT = 1
305         CALL DSYTRS_ROOK( '/', 0, 0, A, 1, IP, B, 1, INFO )
306         CALL CHKXER( 'DSYTRS_ROOK', INFOT, NOUT, LERR, OK )
307         INFOT = 2
308         CALL DSYTRS_ROOK( 'U', -1, 0, A, 1, IP, B, 1, INFO )
309         CALL CHKXER( 'DSYTRS_ROOK', INFOT, NOUT, LERR, OK )
310         INFOT = 3
311         CALL DSYTRS_ROOK( 'U', 0, -1, A, 1, IP, B, 1, INFO )
312         CALL CHKXER( 'DSYTRS_ROOK', INFOT, NOUT, LERR, OK )
313         INFOT = 5
314         CALL DSYTRS_ROOK( 'U', 2, 1, A, 1, IP, B, 2, INFO )
315         CALL CHKXER( 'DSYTRS_ROOK', INFOT, NOUT, LERR, OK )
316         INFOT = 8
317         CALL DSYTRS_ROOK( 'U', 2, 1, A, 2, IP, B, 1, INFO )
318         CALL CHKXER( 'DSYTRS_ROOK', INFOT, NOUT, LERR, OK )
319*
320*        DSYCON_ROOK
321*
322         SRNAMT = 'DSYCON_ROOK'
323         INFOT = 1
324         CALL DSYCON_ROOK( '/', 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
325         CALL CHKXER( 'DSYCON_ROOK', INFOT, NOUT, LERR, OK )
326         INFOT = 2
327         CALL DSYCON_ROOK( 'U', -1, A, 1, IP, ANRM, RCOND, W, IW, INFO )
328         CALL CHKXER( 'DSYCON_ROOK', INFOT, NOUT, LERR, OK )
329         INFOT = 4
330         CALL DSYCON_ROOK( 'U', 2, A, 1, IP, ANRM, RCOND, W, IW, INFO )
331         CALL CHKXER( 'DSYCON_ROOK', INFOT, NOUT, LERR, OK )
332         INFOT = 6
333         CALL DSYCON_ROOK( 'U', 1, A, 1, IP, -1.0D0, RCOND, W, IW, INFO)
334         CALL CHKXER( 'DSYCON_ROOK', INFOT, NOUT, LERR, OK )
335*
336      ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
337*
338*        Test error exits of the routines that use factorization
339*        of a symmetric indefinite packed matrix with patrial
340*        (Bunch-Kaufman) pivoting.
341*
342*        DSPTRF
343*
344         SRNAMT = 'DSPTRF'
345         INFOT = 1
346         CALL DSPTRF( '/', 0, A, IP, INFO )
347         CALL CHKXER( 'DSPTRF', INFOT, NOUT, LERR, OK )
348         INFOT = 2
349         CALL DSPTRF( 'U', -1, A, IP, INFO )
350         CALL CHKXER( 'DSPTRF', INFOT, NOUT, LERR, OK )
351*
352*        DSPTRI
353*
354         SRNAMT = 'DSPTRI'
355         INFOT = 1
356         CALL DSPTRI( '/', 0, A, IP, W, INFO )
357         CALL CHKXER( 'DSPTRI', INFOT, NOUT, LERR, OK )
358         INFOT = 2
359         CALL DSPTRI( 'U', -1, A, IP, W, INFO )
360         CALL CHKXER( 'DSPTRI', INFOT, NOUT, LERR, OK )
361*
362*        DSPTRS
363*
364         SRNAMT = 'DSPTRS'
365         INFOT = 1
366         CALL DSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
367         CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
368         INFOT = 2
369         CALL DSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
370         CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
371         INFOT = 3
372         CALL DSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
373         CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
374         INFOT = 7
375         CALL DSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
376         CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
377*
378*        DSPRFS
379*
380         SRNAMT = 'DSPRFS'
381         INFOT = 1
382         CALL DSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
383     $                INFO )
384         CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
385         INFOT = 2
386         CALL DSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
387     $                INFO )
388         CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
389         INFOT = 3
390         CALL DSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
391     $                INFO )
392         CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
393         INFOT = 8
394         CALL DSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, IW,
395     $                INFO )
396         CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
397         INFOT = 10
398         CALL DSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, IW,
399     $                INFO )
400         CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
401*
402*        DSPCON
403*
404         SRNAMT = 'DSPCON'
405         INFOT = 1
406         CALL DSPCON( '/', 0, A, IP, ANRM, RCOND, W, IW, INFO )
407         CALL CHKXER( 'DSPCON', INFOT, NOUT, LERR, OK )
408         INFOT = 2
409         CALL DSPCON( 'U', -1, A, IP, ANRM, RCOND, W, IW, INFO )
410         CALL CHKXER( 'DSPCON', INFOT, NOUT, LERR, OK )
411         INFOT = 5
412         CALL DSPCON( 'U', 1, A, IP, -1.0D0, RCOND, W, IW, INFO )
413         CALL CHKXER( 'DSPCON', INFOT, NOUT, LERR, OK )
414      END IF
415*
416*     Print a summary line.
417*
418      CALL ALAESM( PATH, OK, NOUT )
419*
420      RETURN
421*
422*     End of DERRSY
423*
424      END
425