1*> \brief \b DERREC
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 DERREC( 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*> DERREC tests the error exits for the routines for eigen- condition
25*> estimation for DOUBLE PRECISION matrices:
26*>    DTRSYL, STREXC, STRSNA and STRSEN.
27*> \endverbatim
28*
29*  Arguments:
30*  ==========
31*
32*> \param[in] PATH
33*> \verbatim
34*>          PATH is CHARACTER*3
35*>          The LAPACK path name for the routines to be tested.
36*> \endverbatim
37*>
38*> \param[in] NUNIT
39*> \verbatim
40*>          NUNIT is INTEGER
41*>          The unit number for output.
42*> \endverbatim
43*
44*  Authors:
45*  ========
46*
47*> \author Univ. of Tennessee
48*> \author Univ. of California Berkeley
49*> \author Univ. of Colorado Denver
50*> \author NAG Ltd.
51*
52*> \date November 2011
53*
54*> \ingroup double_eig
55*
56*  =====================================================================
57      SUBROUTINE DERREC( PATH, NUNIT )
58*
59*  -- LAPACK test routine (version 3.4.0) --
60*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
61*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
62*     November 2011
63*
64*     .. Scalar Arguments ..
65      CHARACTER*3        PATH
66      INTEGER            NUNIT
67*     ..
68*
69*  =====================================================================
70*
71*     .. Parameters ..
72      INTEGER            NMAX
73      DOUBLE PRECISION   ONE, ZERO
74      PARAMETER          ( NMAX = 4, ONE = 1.0D0, ZERO = 0.0D0 )
75*     ..
76*     .. Local Scalars ..
77      INTEGER            I, IFST, ILST, INFO, J, M, NT
78      DOUBLE PRECISION   SCALE
79*     ..
80*     .. Local Arrays ..
81      LOGICAL            SEL( NMAX )
82      INTEGER            IWORK( NMAX )
83      DOUBLE PRECISION   A( NMAX, NMAX ), B( NMAX, NMAX ),
84     $                   C( NMAX, NMAX ), S( NMAX ), SEP( NMAX ),
85     $                   WI( NMAX ), WORK( NMAX ), WR( NMAX )
86*     ..
87*     .. External Subroutines ..
88      EXTERNAL           CHKXER, DTREXC, DTRSEN, DTRSNA, DTRSYL
89*     ..
90*     .. Scalars in Common ..
91      LOGICAL            LERR, OK
92      CHARACTER*32       SRNAMT
93      INTEGER            INFOT, NOUT
94*     ..
95*     .. Common blocks ..
96      COMMON             / INFOC / INFOT, NOUT, OK, LERR
97      COMMON             / SRNAMC / SRNAMT
98*     ..
99*     .. Executable Statements ..
100*
101      NOUT = NUNIT
102      OK = .TRUE.
103      NT = 0
104*
105*     Initialize A, B and SEL
106*
107      DO 20 J = 1, NMAX
108         DO 10 I = 1, NMAX
109            A( I, J ) = ZERO
110            B( I, J ) = ZERO
111   10    CONTINUE
112   20 CONTINUE
113      DO 30 I = 1, NMAX
114         A( I, I ) = ONE
115         SEL( I ) = .TRUE.
116   30 CONTINUE
117*
118*     Test DTRSYL
119*
120      SRNAMT = 'DTRSYL'
121      INFOT = 1
122      CALL DTRSYL( 'X', 'N', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
123      CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
124      INFOT = 2
125      CALL DTRSYL( 'N', 'X', 1, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
126      CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
127      INFOT = 3
128      CALL DTRSYL( 'N', 'N', 0, 0, 0, A, 1, B, 1, C, 1, SCALE, INFO )
129      CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
130      INFOT = 4
131      CALL DTRSYL( 'N', 'N', 1, -1, 0, A, 1, B, 1, C, 1, SCALE, INFO )
132      CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
133      INFOT = 5
134      CALL DTRSYL( 'N', 'N', 1, 0, -1, A, 1, B, 1, C, 1, SCALE, INFO )
135      CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
136      INFOT = 7
137      CALL DTRSYL( 'N', 'N', 1, 2, 0, A, 1, B, 1, C, 2, SCALE, INFO )
138      CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
139      INFOT = 9
140      CALL DTRSYL( 'N', 'N', 1, 0, 2, A, 1, B, 1, C, 1, SCALE, INFO )
141      CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
142      INFOT = 11
143      CALL DTRSYL( 'N', 'N', 1, 2, 0, A, 2, B, 1, C, 1, SCALE, INFO )
144      CALL CHKXER( 'DTRSYL', INFOT, NOUT, LERR, OK )
145      NT = NT + 8
146*
147*     Test DTREXC
148*
149      SRNAMT = 'DTREXC'
150      IFST = 1
151      ILST = 1
152      INFOT = 1
153      CALL DTREXC( 'X', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
154      CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
155      INFOT = 7
156      CALL DTREXC( 'N', 0, A, 1, B, 1, IFST, ILST, WORK, INFO )
157      CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
158      INFOT = 4
159      ILST = 2
160      CALL DTREXC( 'N', 2, A, 1, B, 1, IFST, ILST, WORK, INFO )
161      CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
162      INFOT = 6
163      CALL DTREXC( 'V', 2, A, 2, B, 1, IFST, ILST, WORK, INFO )
164      CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
165      INFOT = 7
166      IFST = 0
167      ILST = 1
168      CALL DTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
169      CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
170      INFOT = 7
171      IFST = 2
172      CALL DTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
173      CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
174      INFOT = 8
175      IFST = 1
176      ILST = 0
177      CALL DTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
178      CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
179      INFOT = 8
180      ILST = 2
181      CALL DTREXC( 'V', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
182      CALL CHKXER( 'DTREXC', INFOT, NOUT, LERR, OK )
183      NT = NT + 8
184*
185*     Test DTRSNA
186*
187      SRNAMT = 'DTRSNA'
188      INFOT = 1
189      CALL DTRSNA( 'X', 'A', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
190     $             WORK, 1, IWORK, INFO )
191      CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
192      INFOT = 2
193      CALL DTRSNA( 'B', 'X', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
194     $             WORK, 1, IWORK, INFO )
195      CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
196      INFOT = 4
197      CALL DTRSNA( 'B', 'A', SEL, -1, A, 1, B, 1, C, 1, S, SEP, 1, M,
198     $             WORK, 1, IWORK, INFO )
199      CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
200      INFOT = 6
201      CALL DTRSNA( 'V', 'A', SEL, 2, A, 1, B, 1, C, 1, S, SEP, 2, M,
202     $             WORK, 2, IWORK, INFO )
203      CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
204      INFOT = 8
205      CALL DTRSNA( 'B', 'A', SEL, 2, A, 2, B, 1, C, 2, S, SEP, 2, M,
206     $             WORK, 2, IWORK, INFO )
207      CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
208      INFOT = 10
209      CALL DTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 1, S, SEP, 2, M,
210     $             WORK, 2, IWORK, INFO )
211      CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
212      INFOT = 13
213      CALL DTRSNA( 'B', 'A', SEL, 1, A, 1, B, 1, C, 1, S, SEP, 0, M,
214     $             WORK, 1, IWORK, INFO )
215      CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
216      INFOT = 13
217      CALL DTRSNA( 'B', 'S', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 1, M,
218     $             WORK, 2, IWORK, INFO )
219      CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
220      INFOT = 16
221      CALL DTRSNA( 'B', 'A', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 2, M,
222     $             WORK, 1, IWORK, INFO )
223      CALL CHKXER( 'DTRSNA', INFOT, NOUT, LERR, OK )
224      NT = NT + 9
225*
226*     Test DTRSEN
227*
228      SEL( 1 ) = .FALSE.
229      SRNAMT = 'DTRSEN'
230      INFOT = 1
231      CALL DTRSEN( 'X', 'N', SEL, 0, A, 1, B, 1, WR, WI, M, S( 1 ),
232     $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
233      CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
234      INFOT = 2
235      CALL DTRSEN( 'N', 'X', SEL, 0, A, 1, B, 1, WR, WI, M, S( 1 ),
236     $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
237      CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
238      INFOT = 4
239      CALL DTRSEN( 'N', 'N', SEL, -1, A, 1, B, 1, WR, WI, M, S( 1 ),
240     $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
241      CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
242      INFOT = 6
243      CALL DTRSEN( 'N', 'N', SEL, 2, A, 1, B, 1, WR, WI, M, S( 1 ),
244     $             SEP( 1 ), WORK, 2, IWORK, 1, INFO )
245      CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
246      INFOT = 8
247      CALL DTRSEN( 'N', 'V', SEL, 2, A, 2, B, 1, WR, WI, M, S( 1 ),
248     $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
249      CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
250      INFOT = 15
251      CALL DTRSEN( 'N', 'V', SEL, 2, A, 2, B, 2, WR, WI, M, S( 1 ),
252     $             SEP( 1 ), WORK, 0, IWORK, 1, INFO )
253      CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
254      INFOT = 15
255      CALL DTRSEN( 'E', 'V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
256     $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
257      CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
258      INFOT = 15
259      CALL DTRSEN( 'V', 'V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
260     $             SEP( 1 ), WORK, 3, IWORK, 2, INFO )
261      CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
262      INFOT = 17
263      CALL DTRSEN( 'E', 'V', SEL, 2, A, 2, B, 2, WR, WI, M, S( 1 ),
264     $             SEP( 1 ), WORK, 1, IWORK, 0, INFO )
265      CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
266      INFOT = 17
267      CALL DTRSEN( 'V', 'V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
268     $             SEP( 1 ), WORK, 4, IWORK, 1, INFO )
269      CALL CHKXER( 'DTRSEN', INFOT, NOUT, LERR, OK )
270      NT = NT + 10
271*
272*     Print a summary line.
273*
274      IF( OK ) THEN
275         WRITE( NOUT, FMT = 9999 )PATH, NT
276      ELSE
277         WRITE( NOUT, FMT = 9998 )PATH
278      END IF
279*
280      RETURN
281 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits (',
282     $      I3, ' tests done)' )
283 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ex',
284     $      'its ***' )
285*
286*     End of DERREC
287*
288      END
289