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