LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
derrgg.f
Go to the documentation of this file.
1 *> \brief \b DERRGG
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 DERRGG( 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 *> DERRGG tests the error exits for DGGES, DGGESX, DGGEV, DGGEVX,
25 *> DGGGLM, DGGHRD, DGGLSE, DGGQRF, DGGRQF, DGGSVD, DGGSVP, DHGEQZ,
26 *> DORCSD, DTGEVC, DTGEXC, DTGSEN, DTGSJA, DTGSNA, and DTGSYL.
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 derrgg( 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, LW
73  parameter( nmax = 3, lw = 6*nmax )
74  DOUBLE PRECISION ONE, ZERO
75  parameter( one = 1.0d+0, zero = 0.0d+0 )
76 * ..
77 * .. Local Scalars ..
78  CHARACTER*2 C2
79  INTEGER DUMMYK, DUMMYL, I, IFST, ILO, IHI, ILST, INFO,
80  $ j, m, ncycle, nt, sdim
81  DOUBLE PRECISION ANRM, BNRM, DIF, SCALE, TOLA, TOLB
82 * ..
83 * .. Local Arrays ..
84  LOGICAL BW( nmax ), SEL( nmax )
85  INTEGER IW( nmax )
86  DOUBLE PRECISION A( nmax, nmax ), B( nmax, nmax ), LS( nmax ),
87  $ q( nmax, nmax ), r1( nmax ), r2( nmax ),
88  $ r3( nmax ), rce( 2 ), rcv( 2 ), rs( nmax ),
89  $ tau( nmax ), u( nmax, nmax ), v( nmax, nmax ),
90  $ w( lw ), z( nmax, nmax )
91 * ..
92 * .. External Functions ..
93  LOGICAL DLCTES, DLCTSX, LSAMEN
94  EXTERNAL dlctes, dlctsx, lsamen
95 * ..
96 * .. External Subroutines ..
97  EXTERNAL chkxer, dgges, dggesx, dggev, dggevx, dggglm,
100  $ dtgsna, dtgsyl
101 * ..
102 * .. Scalars in Common ..
103  LOGICAL LERR, OK
104  CHARACTER*32 SRNAMT
105  INTEGER INFOT, NOUT
106 * ..
107 * .. Common blocks ..
108  COMMON / infoc / infot, nout, ok, lerr
109  COMMON / srnamc / srnamt
110 * ..
111 * .. Executable Statements ..
112 *
113  nout = nunit
114  WRITE( nout, fmt = * )
115  c2 = path( 2: 3 )
116 *
117 * Set the variables to innocuous values.
118 *
119  DO 20 j = 1, nmax
120  sel( j ) = .true.
121  DO 10 i = 1, nmax
122  a( i, j ) = zero
123  b( i, j ) = zero
124  10 CONTINUE
125  20 CONTINUE
126  DO 30 i = 1, nmax
127  a( i, i ) = one
128  b( i, i ) = one
129  30 CONTINUE
130  ok = .true.
131  tola = 1.0d0
132  tolb = 1.0d0
133  ifst = 1
134  ilst = 1
135  nt = 0
136 *
137 * Test error exits for the GG path.
138 *
139  IF( lsamen( 2, c2, 'GG' ) ) THEN
140 *
141 * DGGHRD
142 *
143  srnamt = 'DGGHRD'
144  infot = 1
145  CALL dgghrd( '/', 'N', 0, 1, 0, a, 1, b, 1, q, 1, z, 1, info )
146  CALL chkxer( 'DGGHRD', infot, nout, lerr, ok )
147  infot = 2
148  CALL dgghrd( 'N', '/', 0, 1, 0, a, 1, b, 1, q, 1, z, 1, info )
149  CALL chkxer( 'DGGHRD', infot, nout, lerr, ok )
150  infot = 3
151  CALL dgghrd( 'N', 'N', -1, 0, 0, a, 1, b, 1, q, 1, z, 1, info )
152  CALL chkxer( 'DGGHRD', infot, nout, lerr, ok )
153  infot = 4
154  CALL dgghrd( 'N', 'N', 0, 0, 0, a, 1, b, 1, q, 1, z, 1, info )
155  CALL chkxer( 'DGGHRD', infot, nout, lerr, ok )
156  infot = 5
157  CALL dgghrd( 'N', 'N', 0, 1, 1, a, 1, b, 1, q, 1, z, 1, info )
158  CALL chkxer( 'DGGHRD', infot, nout, lerr, ok )
159  infot = 7
160  CALL dgghrd( 'N', 'N', 2, 1, 1, a, 1, b, 2, q, 1, z, 1, info )
161  CALL chkxer( 'DGGHRD', infot, nout, lerr, ok )
162  infot = 9
163  CALL dgghrd( 'N', 'N', 2, 1, 1, a, 2, b, 1, q, 1, z, 1, info )
164  CALL chkxer( 'DGGHRD', infot, nout, lerr, ok )
165  infot = 11
166  CALL dgghrd( 'V', 'N', 2, 1, 1, a, 2, b, 2, q, 1, z, 1, info )
167  CALL chkxer( 'DGGHRD', infot, nout, lerr, ok )
168  infot = 13
169  CALL dgghrd( 'N', 'V', 2, 1, 1, a, 2, b, 2, q, 1, z, 1, info )
170  CALL chkxer( 'DGGHRD', infot, nout, lerr, ok )
171  nt = nt + 9
172 *
173 * DHGEQZ
174 *
175  srnamt = 'DHGEQZ'
176  infot = 1
177  CALL dhgeqz( '/', 'N', 'N', 0, 1, 0, a, 1, b, 1, r1, r2, r3, q,
178  $ 1, z, 1, w, lw, info )
179  CALL chkxer( 'DHGEQZ', infot, nout, lerr, ok )
180  infot = 2
181  CALL dhgeqz( 'E', '/', 'N', 0, 1, 0, a, 1, b, 1, r1, r2, r3, q,
182  $ 1, z, 1, w, lw, info )
183  CALL chkxer( 'DHGEQZ', infot, nout, lerr, ok )
184  infot = 3
185  CALL dhgeqz( 'E', 'N', '/', 0, 1, 0, a, 1, b, 1, r1, r2, r3, q,
186  $ 1, z, 1, w, lw, info )
187  CALL chkxer( 'DHGEQZ', infot, nout, lerr, ok )
188  infot = 4
189  CALL dhgeqz( 'E', 'N', 'N', -1, 0, 0, a, 1, b, 1, r1, r2, r3,
190  $ q, 1, z, 1, w, lw, info )
191  CALL chkxer( 'DHGEQZ', infot, nout, lerr, ok )
192  infot = 5
193  CALL dhgeqz( 'E', 'N', 'N', 0, 0, 0, a, 1, b, 1, r1, r2, r3, q,
194  $ 1, z, 1, w, lw, info )
195  CALL chkxer( 'DHGEQZ', infot, nout, lerr, ok )
196  infot = 6
197  CALL dhgeqz( 'E', 'N', 'N', 0, 1, 1, a, 1, b, 1, r1, r2, r3, q,
198  $ 1, z, 1, w, lw, info )
199  CALL chkxer( 'DHGEQZ', infot, nout, lerr, ok )
200  infot = 8
201  CALL dhgeqz( 'E', 'N', 'N', 2, 1, 1, a, 1, b, 2, r1, r2, r3, q,
202  $ 1, z, 1, w, lw, info )
203  CALL chkxer( 'DHGEQZ', infot, nout, lerr, ok )
204  infot = 10
205  CALL dhgeqz( 'E', 'N', 'N', 2, 1, 1, a, 2, b, 1, r1, r2, r3, q,
206  $ 1, z, 1, w, lw, info )
207  CALL chkxer( 'DHGEQZ', infot, nout, lerr, ok )
208  infot = 15
209  CALL dhgeqz( 'E', 'V', 'N', 2, 1, 1, a, 2, b, 2, r1, r2, r3, q,
210  $ 1, z, 1, w, lw, info )
211  CALL chkxer( 'DHGEQZ', infot, nout, lerr, ok )
212  infot = 17
213  CALL dhgeqz( 'E', 'N', 'V', 2, 1, 1, a, 2, b, 2, r1, r2, r3, q,
214  $ 1, z, 1, w, lw, info )
215  CALL chkxer( 'DHGEQZ', infot, nout, lerr, ok )
216  nt = nt + 10
217 *
218 * DTGEVC
219 *
220  srnamt = 'DTGEVC'
221  infot = 1
222  CALL dtgevc( '/', 'A', sel, 0, a, 1, b, 1, q, 1, z, 1, 0, m, w,
223  $ info )
224  CALL chkxer( 'DTGEVC', infot, nout, lerr, ok )
225  infot = 2
226  CALL dtgevc( 'R', '/', sel, 0, a, 1, b, 1, q, 1, z, 1, 0, m, w,
227  $ info )
228  CALL chkxer( 'DTGEVC', infot, nout, lerr, ok )
229  infot = 4
230  CALL dtgevc( 'R', 'A', sel, -1, a, 1, b, 1, q, 1, z, 1, 0, m,
231  $ w, info )
232  CALL chkxer( 'DTGEVC', infot, nout, lerr, ok )
233  infot = 6
234  CALL dtgevc( 'R', 'A', sel, 2, a, 1, b, 2, q, 1, z, 2, 0, m, w,
235  $ info )
236  CALL chkxer( 'DTGEVC', infot, nout, lerr, ok )
237  infot = 8
238  CALL dtgevc( 'R', 'A', sel, 2, a, 2, b, 1, q, 1, z, 2, 0, m, w,
239  $ info )
240  CALL chkxer( 'DTGEVC', infot, nout, lerr, ok )
241  infot = 10
242  CALL dtgevc( 'L', 'A', sel, 2, a, 2, b, 2, q, 1, z, 1, 0, m, w,
243  $ info )
244  CALL chkxer( 'DTGEVC', infot, nout, lerr, ok )
245  infot = 12
246  CALL dtgevc( 'R', 'A', sel, 2, a, 2, b, 2, q, 1, z, 1, 0, m, w,
247  $ info )
248  CALL chkxer( 'DTGEVC', infot, nout, lerr, ok )
249  infot = 13
250  CALL dtgevc( 'R', 'A', sel, 2, a, 2, b, 2, q, 1, z, 2, 1, m, w,
251  $ info )
252  CALL chkxer( 'DTGEVC', infot, nout, lerr, ok )
253  nt = nt + 8
254 *
255 * Test error exits for the GSV path.
256 *
257  ELSE IF( lsamen( 3, path, 'GSV' ) ) THEN
258 *
259 * DGGSVD
260 *
261  srnamt = 'DGGSVD'
262  infot = 1
263  CALL dggsvd( '/', 'N', 'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
264  $ 1, r1, r2, u, 1, v, 1, q, 1, w, iw, info )
265  CALL chkxer( 'DGGSVD', infot, nout, lerr, ok )
266  infot = 2
267  CALL dggsvd( 'N', '/', 'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
268  $ 1, r1, r2, u, 1, v, 1, q, 1, w, iw, info )
269  CALL chkxer( 'DGGSVD', infot, nout, lerr, ok )
270  infot = 3
271  CALL dggsvd( 'N', 'N', '/', 0, 0, 0, dummyk, dummyl, a, 1, b,
272  $ 1, r1, r2, u, 1, v, 1, q, 1, w, iw, info )
273  CALL chkxer( 'DGGSVD', infot, nout, lerr, ok )
274  infot = 4
275  CALL dggsvd( 'N', 'N', 'N', -1, 0, 0, dummyk, dummyl, a, 1, b,
276  $ 1, r1, r2, u, 1, v, 1, q, 1, w, iw, info )
277  CALL chkxer( 'DGGSVD', infot, nout, lerr, ok )
278  infot = 5
279  CALL dggsvd( 'N', 'N', 'N', 0, -1, 0, dummyk, dummyl, a, 1, b,
280  $ 1, r1, r2, u, 1, v, 1, q, 1, w, iw, info )
281  CALL chkxer( 'DGGSVD', infot, nout, lerr, ok )
282  infot = 6
283  CALL dggsvd( 'N', 'N', 'N', 0, 0, -1, dummyk, dummyl, a, 1, b,
284  $ 1, r1, r2, u, 1, v, 1, q, 1, w, iw, info )
285  CALL chkxer( 'DGGSVD', infot, nout, lerr, ok )
286  infot = 10
287  CALL dggsvd( 'N', 'N', 'N', 2, 1, 1, dummyk, dummyl, a, 1, b,
288  $ 1, r1, r2, u, 1, v, 1, q, 1, w, iw, info )
289  CALL chkxer( 'DGGSVD', infot, nout, lerr, ok )
290  infot = 12
291  CALL dggsvd( 'N', 'N', 'N', 1, 1, 2, dummyk, dummyl, a, 1, b,
292  $ 1, r1, r2, u, 1, v, 1, q, 1, w, iw, info )
293  CALL chkxer( 'DGGSVD', infot, nout, lerr, ok )
294  infot = 16
295  CALL dggsvd( 'U', 'N', 'N', 2, 2, 2, dummyk, dummyl, a, 2, b,
296  $ 2, r1, r2, u, 1, v, 1, q, 1, w, iw, info )
297  CALL chkxer( 'DGGSVD', infot, nout, lerr, ok )
298  infot = 18
299  CALL dggsvd( 'N', 'V', 'N', 1, 1, 2, dummyk, dummyl, a, 1, b,
300  $ 2, r1, r2, u, 1, v, 1, q, 1, w, iw, info )
301  CALL chkxer( 'DGGSVD', infot, nout, lerr, ok )
302  infot = 20
303  CALL dggsvd( 'N', 'N', 'Q', 1, 2, 1, dummyk, dummyl, a, 1, b,
304  $ 1, r1, r2, u, 1, v, 1, q, 1, w, iw, info )
305  CALL chkxer( 'DGGSVD', infot, nout, lerr, ok )
306  nt = nt + 11
307 *
308 * DGGSVP
309 *
310  srnamt = 'DGGSVP'
311  infot = 1
312  CALL dggsvp( '/', 'N', 'N', 0, 0, 0, a, 1, b, 1, tola, tolb,
313  $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, tau, w,
314  $ info )
315  CALL chkxer( 'DGGSVP', infot, nout, lerr, ok )
316  infot = 2
317  CALL dggsvp( 'N', '/', 'N', 0, 0, 0, a, 1, b, 1, tola, tolb,
318  $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, tau, w,
319  $ info )
320  CALL chkxer( 'DGGSVP', infot, nout, lerr, ok )
321  infot = 3
322  CALL dggsvp( 'N', 'N', '/', 0, 0, 0, a, 1, b, 1, tola, tolb,
323  $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, tau, w,
324  $ info )
325  CALL chkxer( 'DGGSVP', infot, nout, lerr, ok )
326  infot = 4
327  CALL dggsvp( 'N', 'N', 'N', -1, 0, 0, a, 1, b, 1, tola, tolb,
328  $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, tau, w,
329  $ info )
330  CALL chkxer( 'DGGSVP', infot, nout, lerr, ok )
331  infot = 5
332  CALL dggsvp( 'N', 'N', 'N', 0, -1, 0, a, 1, b, 1, tola, tolb,
333  $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, tau, w,
334  $ info )
335  CALL chkxer( 'DGGSVP', infot, nout, lerr, ok )
336  infot = 6
337  CALL dggsvp( 'N', 'N', 'N', 0, 0, -1, a, 1, b, 1, tola, tolb,
338  $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, tau, w,
339  $ info )
340  CALL chkxer( 'DGGSVP', infot, nout, lerr, ok )
341  infot = 8
342  CALL dggsvp( 'N', 'N', 'N', 2, 1, 1, a, 1, b, 1, tola, tolb,
343  $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, tau, w,
344  $ info )
345  CALL chkxer( 'DGGSVP', infot, nout, lerr, ok )
346  infot = 10
347  CALL dggsvp( 'N', 'N', 'N', 1, 2, 1, a, 1, b, 1, tola, tolb,
348  $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, tau, w,
349  $ info )
350  CALL chkxer( 'DGGSVP', infot, nout, lerr, ok )
351  infot = 16
352  CALL dggsvp( 'U', 'N', 'N', 2, 2, 2, a, 2, b, 2, tola, tolb,
353  $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, tau, w,
354  $ info )
355  CALL chkxer( 'DGGSVP', infot, nout, lerr, ok )
356  infot = 18
357  CALL dggsvp( 'N', 'V', 'N', 1, 2, 1, a, 1, b, 2, tola, tolb,
358  $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, tau, w,
359  $ info )
360  CALL chkxer( 'DGGSVP', infot, nout, lerr, ok )
361  infot = 20
362  CALL dggsvp( 'N', 'N', 'Q', 1, 1, 2, a, 1, b, 1, tola, tolb,
363  $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, tau, w,
364  $ info )
365  CALL chkxer( 'DGGSVP', infot, nout, lerr, ok )
366  nt = nt + 11
367 *
368 * DTGSJA
369 *
370  srnamt = 'DTGSJA'
371  infot = 1
372  CALL dtgsja( '/', 'N', 'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
373  $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
374  $ ncycle, info )
375  CALL chkxer( 'DTGSJA', infot, nout, lerr, ok )
376  infot = 2
377  CALL dtgsja( 'N', '/', 'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
378  $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
379  $ ncycle, info )
380  CALL chkxer( 'DTGSJA', infot, nout, lerr, ok )
381  infot = 3
382  CALL dtgsja( 'N', 'N', '/', 0, 0, 0, dummyk, dummyl, a, 1, b,
383  $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
384  $ ncycle, info )
385  CALL chkxer( 'DTGSJA', infot, nout, lerr, ok )
386  infot = 4
387  CALL dtgsja( 'N', 'N', 'N', -1, 0, 0, dummyk, dummyl, a, 1, b,
388  $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
389  $ ncycle, info )
390  CALL chkxer( 'DTGSJA', infot, nout, lerr, ok )
391  infot = 5
392  CALL dtgsja( 'N', 'N', 'N', 0, -1, 0, dummyk, dummyl, a, 1, b,
393  $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
394  $ ncycle, info )
395  CALL chkxer( 'DTGSJA', infot, nout, lerr, ok )
396  infot = 6
397  CALL dtgsja( 'N', 'N', 'N', 0, 0, -1, dummyk, dummyl, a, 1, b,
398  $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
399  $ ncycle, info )
400  CALL chkxer( 'DTGSJA', infot, nout, lerr, ok )
401  infot = 10
402  CALL dtgsja( 'N', 'N', 'N', 0, 0, 0, dummyk, dummyl, a, 0, b,
403  $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
404  $ ncycle, info )
405  CALL chkxer( 'DTGSJA', infot, nout, lerr, ok )
406  infot = 12
407  CALL dtgsja( 'N', 'N', 'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
408  $ 0, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
409  $ ncycle, info )
410  CALL chkxer( 'DTGSJA', infot, nout, lerr, ok )
411  infot = 18
412  CALL dtgsja( 'U', 'N', 'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
413  $ 1, tola, tolb, r1, r2, u, 0, v, 1, q, 1, w,
414  $ ncycle, info )
415  CALL chkxer( 'DTGSJA', infot, nout, lerr, ok )
416  infot = 20
417  CALL dtgsja( 'N', 'V', 'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
418  $ 1, tola, tolb, r1, r2, u, 1, v, 0, q, 1, w,
419  $ ncycle, info )
420  CALL chkxer( 'DTGSJA', infot, nout, lerr, ok )
421  infot = 22
422  CALL dtgsja( 'N', 'N', 'Q', 0, 0, 0, dummyk, dummyl, a, 1, b,
423  $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 0, w,
424  $ ncycle, info )
425  CALL chkxer( 'DTGSJA', infot, nout, lerr, ok )
426  nt = nt + 11
427 *
428 * Test error exits for the GLM path.
429 *
430  ELSE IF( lsamen( 3, path, 'GLM' ) ) THEN
431 *
432 * DGGGLM
433 *
434  srnamt = 'DGGGLM'
435  infot = 1
436  CALL dggglm( -1, 0, 0, a, 1, b, 1, r1, r2, r3, w, lw, info )
437  CALL chkxer( 'DGGGLM', infot, nout, lerr, ok )
438  infot = 2
439  CALL dggglm( 0, -1, 0, a, 1, b, 1, r1, r2, r3, w, lw, info )
440  CALL chkxer( 'DGGGLM', infot, nout, lerr, ok )
441  infot = 2
442  CALL dggglm( 0, 1, 0, a, 1, b, 1, r1, r2, r3, w, lw, info )
443  CALL chkxer( 'DGGGLM', infot, nout, lerr, ok )
444  infot = 3
445  CALL dggglm( 0, 0, -1, a, 1, b, 1, r1, r2, r3, w, lw, info )
446  CALL chkxer( 'DGGGLM', infot, nout, lerr, ok )
447  infot = 3
448  CALL dggglm( 1, 0, 0, a, 1, b, 1, r1, r2, r3, w, lw, info )
449  CALL chkxer( 'DGGGLM', infot, nout, lerr, ok )
450  infot = 5
451  CALL dggglm( 0, 0, 0, a, 0, b, 1, r1, r2, r3, w, lw, info )
452  CALL chkxer( 'DGGGLM', infot, nout, lerr, ok )
453  infot = 7
454  CALL dggglm( 0, 0, 0, a, 1, b, 0, r1, r2, r3, w, lw, info )
455  CALL chkxer( 'DGGGLM', infot, nout, lerr, ok )
456  infot = 12
457  CALL dggglm( 1, 1, 1, a, 1, b, 1, r1, r2, r3, w, 1, info )
458  CALL chkxer( 'DGGGLM', infot, nout, lerr, ok )
459  nt = nt + 8
460 *
461 * Test error exits for the LSE path.
462 *
463  ELSE IF( lsamen( 3, path, 'LSE' ) ) THEN
464 *
465 * DGGLSE
466 *
467  srnamt = 'DGGLSE'
468  infot = 1
469  CALL dgglse( -1, 0, 0, a, 1, b, 1, r1, r2, r3, w, lw, info )
470  CALL chkxer( 'DGGLSE', infot, nout, lerr, ok )
471  infot = 2
472  CALL dgglse( 0, -1, 0, a, 1, b, 1, r1, r2, r3, w, lw, info )
473  CALL chkxer( 'DGGLSE', infot, nout, lerr, ok )
474  infot = 3
475  CALL dgglse( 0, 0, -1, a, 1, b, 1, r1, r2, r3, w, lw, info )
476  CALL chkxer( 'DGGLSE', infot, nout, lerr, ok )
477  infot = 3
478  CALL dgglse( 0, 0, 1, a, 1, b, 1, r1, r2, r3, w, lw, info )
479  CALL chkxer( 'DGGLSE', infot, nout, lerr, ok )
480  infot = 3
481  CALL dgglse( 0, 1, 0, a, 1, b, 1, r1, r2, r3, w, lw, info )
482  CALL chkxer( 'DGGLSE', infot, nout, lerr, ok )
483  infot = 5
484  CALL dgglse( 0, 0, 0, a, 0, b, 1, r1, r2, r3, w, lw, info )
485  CALL chkxer( 'DGGLSE', infot, nout, lerr, ok )
486  infot = 7
487  CALL dgglse( 0, 0, 0, a, 1, b, 0, r1, r2, r3, w, lw, info )
488  CALL chkxer( 'DGGLSE', infot, nout, lerr, ok )
489  infot = 12
490  CALL dgglse( 1, 1, 1, a, 1, b, 1, r1, r2, r3, w, 1, info )
491  CALL chkxer( 'DGGLSE', infot, nout, lerr, ok )
492  nt = nt + 8
493 *
494 * Test error exits for the CSD path.
495 *
496  ELSE IF( lsamen( 3, path, 'CSD' ) ) THEN
497 *
498 * DORCSD
499 *
500  srnamt = 'DORCSD'
501  infot = 7
502  CALL dorcsd( 'Y', 'Y', 'Y', 'Y', 'N', 'N',
503  $ -1, 0, 0, a, 1, a,
504  $ 1, a, 1, a, 1, a,
505  $ a, 1, a, 1, a, 1, a,
506  $ 1, w, lw, iw, info )
507  CALL chkxer( 'DORCSD', infot, nout, lerr, ok )
508  infot = 8
509  CALL dorcsd( 'Y', 'Y', 'Y', 'Y', 'N', 'N',
510  $ 1, -1, 0, a, 1, a,
511  $ 1, a, 1, a, 1, a,
512  $ a, 1, a, 1, a, 1, a,
513  $ 1, w, lw, iw, info )
514  CALL chkxer( 'DORCSD', infot, nout, lerr, ok )
515  infot = 9
516  CALL dorcsd( 'Y', 'Y', 'Y', 'Y', 'N', 'N',
517  $ 1, 1, -1, a, 1, a,
518  $ 1, a, 1, a, 1, a,
519  $ a, 1, a, 1, a, 1, a,
520  $ 1, w, lw, iw, info )
521  CALL chkxer( 'DORCSD', infot, nout, lerr, ok )
522  infot = 11
523  CALL dorcsd( 'Y', 'Y', 'Y', 'Y', 'N', 'N',
524  $ 1, 1, 1, a, -1, a,
525  $ 1, a, 1, a, 1, a,
526  $ a, 1, a, 1, a, 1, a,
527  $ 1, w, lw, iw, info )
528  CALL chkxer( 'DORCSD', infot, nout, lerr, ok )
529  infot = 20
530  CALL dorcsd( 'Y', 'Y', 'Y', 'Y', 'N', 'N',
531  $ 1, 1, 1, a, 1, a,
532  $ 1, a, 1, a, 1, a,
533  $ a, -1, a, 1, a, 1, a,
534  $ 1, w, lw, iw, info )
535  CALL chkxer( 'DORCSD', infot, nout, lerr, ok )
536  infot = 22
537  CALL dorcsd( 'Y', 'Y', 'Y', 'Y', 'N', 'N',
538  $ 1, 1, 1, a, 1, a,
539  $ 1, a, 1, a, 1, a,
540  $ a, 1, a, -1, a, 1, a,
541  $ 1, w, lw, iw, info )
542  CALL chkxer( 'DORCSD', infot, nout, lerr, ok )
543  infot = 24
544  CALL dorcsd( 'Y', 'Y', 'Y', 'Y', 'N', 'N',
545  $ 1, 1, 1, a, 1, a,
546  $ 1, a, 1, a, 1, a,
547  $ a, 1, a, 1, a, -1, a,
548  $ 1, w, lw, iw, info )
549  CALL chkxer( 'DORCSD', infot, nout, lerr, ok )
550  infot = 26
551  CALL dorcsd( 'Y', 'Y', 'Y', 'Y', 'N', 'N',
552  $ 1, 1, 1, a, 1, a,
553  $ 1, a, 1, a, 1, a,
554  $ a, 1, a, 1, a, 1, a,
555  $ -1, w, lw, iw, info )
556  CALL chkxer( 'DORCSD', infot, nout, lerr, ok )
557  nt = nt + 8
558 *
559 * Test error exits for the GQR path.
560 *
561  ELSE IF( lsamen( 3, path, 'GQR' ) ) THEN
562 *
563 * DGGQRF
564 *
565  srnamt = 'DGGQRF'
566  infot = 1
567  CALL dggqrf( -1, 0, 0, a, 1, r1, b, 1, r2, w, lw, info )
568  CALL chkxer( 'DGGQRF', infot, nout, lerr, ok )
569  infot = 2
570  CALL dggqrf( 0, -1, 0, a, 1, r1, b, 1, r2, w, lw, info )
571  CALL chkxer( 'DGGQRF', infot, nout, lerr, ok )
572  infot = 3
573  CALL dggqrf( 0, 0, -1, a, 1, r1, b, 1, r2, w, lw, info )
574  CALL chkxer( 'DGGQRF', infot, nout, lerr, ok )
575  infot = 5
576  CALL dggqrf( 0, 0, 0, a, 0, r1, b, 1, r2, w, lw, info )
577  CALL chkxer( 'DGGQRF', infot, nout, lerr, ok )
578  infot = 8
579  CALL dggqrf( 0, 0, 0, a, 1, r1, b, 0, r2, w, lw, info )
580  CALL chkxer( 'DGGQRF', infot, nout, lerr, ok )
581  infot = 11
582  CALL dggqrf( 1, 1, 2, a, 1, r1, b, 1, r2, w, 1, info )
583  CALL chkxer( 'DGGQRF', infot, nout, lerr, ok )
584  nt = nt + 6
585 *
586 * DGGRQF
587 *
588  srnamt = 'DGGRQF'
589  infot = 1
590  CALL dggrqf( -1, 0, 0, a, 1, r1, b, 1, r2, w, lw, info )
591  CALL chkxer( 'DGGRQF', infot, nout, lerr, ok )
592  infot = 2
593  CALL dggrqf( 0, -1, 0, a, 1, r1, b, 1, r2, w, lw, info )
594  CALL chkxer( 'DGGRQF', infot, nout, lerr, ok )
595  infot = 3
596  CALL dggrqf( 0, 0, -1, a, 1, r1, b, 1, r2, w, lw, info )
597  CALL chkxer( 'DGGRQF', infot, nout, lerr, ok )
598  infot = 5
599  CALL dggrqf( 0, 0, 0, a, 0, r1, b, 1, r2, w, lw, info )
600  CALL chkxer( 'DGGRQF', infot, nout, lerr, ok )
601  infot = 8
602  CALL dggrqf( 0, 0, 0, a, 1, r1, b, 0, r2, w, lw, info )
603  CALL chkxer( 'DGGRQF', infot, nout, lerr, ok )
604  infot = 11
605  CALL dggrqf( 1, 1, 2, a, 1, r1, b, 1, r2, w, 1, info )
606  CALL chkxer( 'DGGRQF', infot, nout, lerr, ok )
607  nt = nt + 6
608 *
609 * Test error exits for the DGS, DGV, DGX, and DXV paths.
610 *
611  ELSE IF( lsamen( 3, path, 'DGS' ) .OR.
612  $ lsamen( 3, path, 'DGV' ) .OR.
613  $ lsamen( 3, path, 'DGX' ) .OR. lsamen( 3, path, 'DXV' ) )
614  $ THEN
615 *
616 * DGGES
617 *
618  srnamt = 'DGGES '
619  infot = 1
620  CALL dgges( '/', 'N', 'S', dlctes, 1, a, 1, b, 1, sdim, r1, r2,
621  $ r3, q, 1, u, 1, w, 1, bw, info )
622  CALL chkxer( 'DGGES ', infot, nout, lerr, ok )
623  infot = 2
624  CALL dgges( 'N', '/', 'S', dlctes, 1, a, 1, b, 1, sdim, r1, r2,
625  $ r3, q, 1, u, 1, w, 1, bw, info )
626  CALL chkxer( 'DGGES ', infot, nout, lerr, ok )
627  infot = 3
628  CALL dgges( 'N', 'V', '/', dlctes, 1, a, 1, b, 1, sdim, r1, r2,
629  $ r3, q, 1, u, 1, w, 1, bw, info )
630  CALL chkxer( 'DGGES ', infot, nout, lerr, ok )
631  infot = 5
632  CALL dgges( 'N', 'V', 'S', dlctes, -1, a, 1, b, 1, sdim, r1,
633  $ r2, r3, q, 1, u, 1, w, 1, bw, info )
634  CALL chkxer( 'DGGES ', infot, nout, lerr, ok )
635  infot = 7
636  CALL dgges( 'N', 'V', 'S', dlctes, 1, a, 0, b, 1, sdim, r1, r2,
637  $ r3, q, 1, u, 1, w, 1, bw, info )
638  CALL chkxer( 'DGGES ', infot, nout, lerr, ok )
639  infot = 9
640  CALL dgges( 'N', 'V', 'S', dlctes, 1, a, 1, b, 0, sdim, r1, r2,
641  $ r3, q, 1, u, 1, w, 1, bw, info )
642  CALL chkxer( 'DGGES ', infot, nout, lerr, ok )
643  infot = 15
644  CALL dgges( 'N', 'V', 'S', dlctes, 1, a, 1, b, 1, sdim, r1, r2,
645  $ r3, q, 0, u, 1, w, 1, bw, info )
646  CALL chkxer( 'DGGES ', infot, nout, lerr, ok )
647  infot = 15
648  CALL dgges( 'V', 'V', 'S', dlctes, 2, a, 2, b, 2, sdim, r1, r2,
649  $ r3, q, 1, u, 2, w, 1, bw, info )
650  CALL chkxer( 'DGGES ', infot, nout, lerr, ok )
651  infot = 17
652  CALL dgges( 'N', 'V', 'S', dlctes, 1, a, 1, b, 1, sdim, r1, r2,
653  $ r3, q, 1, u, 0, w, 1, bw, info )
654  CALL chkxer( 'DGGES ', infot, nout, lerr, ok )
655  infot = 17
656  CALL dgges( 'V', 'V', 'S', dlctes, 2, a, 2, b, 2, sdim, r1, r2,
657  $ r3, q, 2, u, 1, w, 1, bw, info )
658  CALL chkxer( 'DGGES ', infot, nout, lerr, ok )
659  infot = 19
660  CALL dgges( 'V', 'V', 'S', dlctes, 2, a, 2, b, 2, sdim, r1, r2,
661  $ r3, q, 2, u, 2, w, 1, bw, info )
662  CALL chkxer( 'DGGES ', infot, nout, lerr, ok )
663  nt = nt + 11
664 *
665 * DGGESX
666 *
667  srnamt = 'DGGESX'
668  infot = 1
669  CALL dggesx( '/', 'N', 'S', dlctsx, 'N', 1, a, 1, b, 1, sdim,
670  $ r1, r2, r3, q, 1, u, 1, rce, rcv, w, 1, iw, 1, bw,
671  $ info )
672  CALL chkxer( 'DGGESX', infot, nout, lerr, ok )
673  infot = 2
674  CALL dggesx( 'N', '/', 'S', dlctsx, 'N', 1, a, 1, b, 1, sdim,
675  $ r1, r2, r3, q, 1, u, 1, rce, rcv, w, 1, iw, 1, bw,
676  $ info )
677  CALL chkxer( 'DGGESX', infot, nout, lerr, ok )
678  infot = 3
679  CALL dggesx( 'V', 'V', '/', dlctsx, 'N', 1, a, 1, b, 1, sdim,
680  $ r1, r2, r3, q, 1, u, 1, rce, rcv, w, 1, iw, 1, bw,
681  $ info )
682  CALL chkxer( 'DGGESX', infot, nout, lerr, ok )
683  infot = 5
684  CALL dggesx( 'V', 'V', 'S', dlctsx, '/', 1, a, 1, b, 1, sdim,
685  $ r1, r2, r3, q, 1, u, 1, rce, rcv, w, 1, iw, 1, bw,
686  $ info )
687  CALL chkxer( 'DGGESX', infot, nout, lerr, ok )
688  infot = 6
689  CALL dggesx( 'V', 'V', 'S', dlctsx, 'B', -1, a, 1, b, 1, sdim,
690  $ r1, r2, r3, q, 1, u, 1, rce, rcv, w, 1, iw, 1, bw,
691  $ info )
692  CALL chkxer( 'DGGESX', infot, nout, lerr, ok )
693  infot = 8
694  CALL dggesx( 'V', 'V', 'S', dlctsx, 'B', 1, a, 0, b, 1, sdim,
695  $ r1, r2, r3, q, 1, u, 1, rce, rcv, w, 1, iw, 1, bw,
696  $ info )
697  CALL chkxer( 'DGGESX', infot, nout, lerr, ok )
698  infot = 10
699  CALL dggesx( 'V', 'V', 'S', dlctsx, 'B', 1, a, 1, b, 0, sdim,
700  $ r1, r2, r3, q, 1, u, 1, rce, rcv, w, 1, iw, 1, bw,
701  $ info )
702  CALL chkxer( 'DGGESX', infot, nout, lerr, ok )
703  infot = 16
704  CALL dggesx( 'V', 'V', 'S', dlctsx, 'B', 1, a, 1, b, 1, sdim,
705  $ r1, r2, r3, q, 0, u, 1, rce, rcv, w, 1, iw, 1, bw,
706  $ info )
707  CALL chkxer( 'DGGESX', infot, nout, lerr, ok )
708  infot = 16
709  CALL dggesx( 'V', 'V', 'S', dlctsx, 'B', 2, a, 2, b, 2, sdim,
710  $ r1, r2, r3, q, 1, u, 1, rce, rcv, w, 1, iw, 1, bw,
711  $ info )
712  CALL chkxer( 'DGGESX', infot, nout, lerr, ok )
713  infot = 18
714  CALL dggesx( 'V', 'V', 'S', dlctsx, 'B', 1, a, 1, b, 1, sdim,
715  $ r1, r2, r3, q, 1, u, 0, rce, rcv, w, 1, iw, 1, bw,
716  $ info )
717  CALL chkxer( 'DGGESX', infot, nout, lerr, ok )
718  infot = 18
719  CALL dggesx( 'V', 'V', 'S', dlctsx, 'B', 2, a, 2, b, 2, sdim,
720  $ r1, r2, r3, q, 2, u, 1, rce, rcv, w, 1, iw, 1, bw,
721  $ info )
722  CALL chkxer( 'DGGESX', infot, nout, lerr, ok )
723  infot = 22
724  CALL dggesx( 'V', 'V', 'S', dlctsx, 'B', 2, a, 2, b, 2, sdim,
725  $ r1, r2, r3, q, 2, u, 2, rce, rcv, w, 1, iw, 1, bw,
726  $ info )
727  CALL chkxer( 'DGGESX', infot, nout, lerr, ok )
728  infot = 24
729  CALL dggesx( 'V', 'V', 'S', dlctsx, 'V', 1, a, 1, b, 1, sdim,
730  $ r1, r2, r3, q, 1, u, 1, rce, rcv, w, 32, iw, 0,
731  $ bw, info )
732  CALL chkxer( 'DGGESX', infot, nout, lerr, ok )
733  nt = nt + 13
734 *
735 * DGGEV
736 *
737  srnamt = 'DGGEV '
738  infot = 1
739  CALL dggev( '/', 'N', 1, a, 1, b, 1, r1, r2, r3, q, 1, u, 1, w,
740  $ 1, info )
741  CALL chkxer( 'DGGEV ', infot, nout, lerr, ok )
742  infot = 2
743  CALL dggev( 'N', '/', 1, a, 1, b, 1, r1, r2, r3, q, 1, u, 1, w,
744  $ 1, info )
745  CALL chkxer( 'DGGEV ', infot, nout, lerr, ok )
746  infot = 3
747  CALL dggev( 'V', 'V', -1, a, 1, b, 1, r1, r2, r3, q, 1, u, 1,
748  $ w, 1, info )
749  CALL chkxer( 'DGGEV ', infot, nout, lerr, ok )
750  infot = 5
751  CALL dggev( 'V', 'V', 1, a, 0, b, 1, r1, r2, r3, q, 1, u, 1, w,
752  $ 1, info )
753  CALL chkxer( 'DGGEV ', infot, nout, lerr, ok )
754  infot = 7
755  CALL dggev( 'V', 'V', 1, a, 1, b, 0, r1, r2, r3, q, 1, u, 1, w,
756  $ 1, info )
757  CALL chkxer( 'DGGEV ', infot, nout, lerr, ok )
758  infot = 12
759  CALL dggev( 'N', 'V', 1, a, 1, b, 1, r1, r2, r3, q, 0, u, 1, w,
760  $ 1, info )
761  CALL chkxer( 'DGGEV ', infot, nout, lerr, ok )
762  infot = 12
763  CALL dggev( 'V', 'V', 2, a, 2, b, 2, r1, r2, r3, q, 1, u, 2, w,
764  $ 1, info )
765  CALL chkxer( 'DGGEV ', infot, nout, lerr, ok )
766  infot = 14
767  CALL dggev( 'V', 'N', 2, a, 2, b, 2, r1, r2, r3, q, 2, u, 0, w,
768  $ 1, info )
769  CALL chkxer( 'DGGEV ', infot, nout, lerr, ok )
770  infot = 14
771  CALL dggev( 'V', 'V', 2, a, 2, b, 2, r1, r2, r3, q, 2, u, 1, w,
772  $ 1, info )
773  CALL chkxer( 'DGGEV ', infot, nout, lerr, ok )
774  infot = 16
775  CALL dggev( 'V', 'V', 1, a, 1, b, 1, r1, r2, r3, q, 1, u, 1, w,
776  $ 1, info )
777  CALL chkxer( 'DGGEV ', infot, nout, lerr, ok )
778  nt = nt + 10
779 *
780 * DGGEVX
781 *
782  srnamt = 'DGGEVX'
783  infot = 1
784  CALL dggevx( '/', 'N', 'N', 'N', 1, a, 1, b, 1, r1, r2, r3, q,
785  $ 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
786  $ w, 1, iw, bw, info )
787  CALL chkxer( 'DGGEVX', infot, nout, lerr, ok )
788  infot = 2
789  CALL dggevx( 'N', '/', 'N', 'N', 1, a, 1, b, 1, r1, r2, r3, q,
790  $ 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
791  $ w, 1, iw, bw, info )
792  CALL chkxer( 'DGGEVX', infot, nout, lerr, ok )
793  infot = 3
794  CALL dggevx( 'N', 'N', '/', 'N', 1, a, 1, b, 1, r1, r2, r3, q,
795  $ 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
796  $ w, 1, iw, bw, info )
797  CALL chkxer( 'DGGEVX', infot, nout, lerr, ok )
798  infot = 4
799  CALL dggevx( 'N', 'N', 'N', '/', 1, a, 1, b, 1, r1, r2, r3, q,
800  $ 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
801  $ w, 1, iw, bw, info )
802  CALL chkxer( 'DGGEVX', infot, nout, lerr, ok )
803  infot = 5
804  CALL dggevx( 'N', 'N', 'N', 'N', -1, a, 1, b, 1, r1, r2, r3, q,
805  $ 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
806  $ w, 1, iw, bw, info )
807  CALL chkxer( 'DGGEVX', infot, nout, lerr, ok )
808  infot = 7
809  CALL dggevx( 'N', 'N', 'N', 'N', 1, a, 0, b, 1, r1, r2, r3, q,
810  $ 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
811  $ w, 1, iw, bw, info )
812  CALL chkxer( 'DGGEVX', infot, nout, lerr, ok )
813  infot = 9
814  CALL dggevx( 'N', 'N', 'N', 'N', 1, a, 1, b, 0, r1, r2, r3, q,
815  $ 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
816  $ w, 1, iw, bw, info )
817  CALL chkxer( 'DGGEVX', infot, nout, lerr, ok )
818  infot = 14
819  CALL dggevx( 'N', 'N', 'N', 'N', 1, a, 1, b, 1, r1, r2, r3, q,
820  $ 0, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
821  $ w, 1, iw, bw, info )
822  CALL chkxer( 'DGGEVX', infot, nout, lerr, ok )
823  infot = 14
824  CALL dggevx( 'N', 'V', 'N', 'N', 2, a, 2, b, 2, r1, r2, r3, q,
825  $ 1, u, 2, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
826  $ w, 1, iw, bw, info )
827  CALL chkxer( 'DGGEVX', infot, nout, lerr, ok )
828  infot = 16
829  CALL dggevx( 'N', 'N', 'N', 'N', 1, a, 1, b, 1, r1, r2, r3, q,
830  $ 1, u, 0, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
831  $ w, 1, iw, bw, info )
832  CALL chkxer( 'DGGEVX', infot, nout, lerr, ok )
833  infot = 16
834  CALL dggevx( 'N', 'N', 'V', 'N', 2, a, 2, b, 2, r1, r2, r3, q,
835  $ 2, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
836  $ w, 1, iw, bw, info )
837  CALL chkxer( 'DGGEVX', infot, nout, lerr, ok )
838  infot = 26
839  CALL dggevx( 'N', 'N', 'V', 'N', 2, a, 2, b, 2, r1, r2, r3, q,
840  $ 2, u, 2, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
841  $ w, 1, iw, bw, info )
842  CALL chkxer( 'DGGEVX', infot, nout, lerr, ok )
843  nt = nt + 12
844 *
845 * DTGEXC
846 *
847  srnamt = 'DTGEXC'
848  infot = 3
849  CALL dtgexc( .true., .true., -1, a, 1, b, 1, q, 1, z, 1, ifst,
850  $ ilst, w, 1, info )
851  CALL chkxer( 'DTGEXC', infot, nout, lerr, ok )
852  infot = 5
853  CALL dtgexc( .true., .true., 1, a, 0, b, 1, q, 1, z, 1, ifst,
854  $ ilst, w, 1, info )
855  CALL chkxer( 'DTGEXC', infot, nout, lerr, ok )
856  infot = 7
857  CALL dtgexc( .true., .true., 1, a, 1, b, 0, q, 1, z, 1, ifst,
858  $ ilst, w, 1, info )
859  CALL chkxer( 'DTGEXC', infot, nout, lerr, ok )
860  infot = 9
861  CALL dtgexc( .false., .true., 1, a, 1, b, 1, q, 0, z, 1, ifst,
862  $ ilst, w, 1, info )
863  CALL chkxer( 'DTGEXC', infot, nout, lerr, ok )
864  infot = 9
865  CALL dtgexc( .true., .true., 1, a, 1, b, 1, q, 0, z, 1, ifst,
866  $ ilst, w, 1, info )
867  CALL chkxer( 'DTGEXC', infot, nout, lerr, ok )
868  infot = 11
869  CALL dtgexc( .true., .false., 1, a, 1, b, 1, q, 1, z, 0, ifst,
870  $ ilst, w, 1, info )
871  CALL chkxer( 'DTGEXC', infot, nout, lerr, ok )
872  infot = 11
873  CALL dtgexc( .true., .true., 1, a, 1, b, 1, q, 1, z, 0, ifst,
874  $ ilst, w, 1, info )
875  CALL chkxer( 'DTGEXC', infot, nout, lerr, ok )
876  infot = 15
877  CALL dtgexc( .true., .true., 1, a, 1, b, 1, q, 1, z, 1, ifst,
878  $ ilst, w, 0, info )
879  CALL chkxer( 'DTGEXC', infot, nout, lerr, ok )
880  nt = nt + 8
881 *
882 * DTGSEN
883 *
884  srnamt = 'DTGSEN'
885  infot = 1
886  CALL dtgsen( -1, .true., .true., sel, 1, a, 1, b, 1, r1, r2,
887  $ r3, q, 1, z, 1, m, tola, tolb, rcv, w, 1, iw, 1,
888  $ info )
889  CALL chkxer( 'DTGSEN', infot, nout, lerr, ok )
890  infot = 5
891  CALL dtgsen( 1, .true., .true., sel, -1, a, 1, b, 1, r1, r2,
892  $ r3, q, 1, z, 1, m, tola, tolb, rcv, w, 1, iw, 1,
893  $ info )
894  CALL chkxer( 'DTGSEN', infot, nout, lerr, ok )
895  infot = 7
896  CALL dtgsen( 1, .true., .true., sel, 1, a, 0, b, 1, r1, r2, r3,
897  $ q, 1, z, 1, m, tola, tolb, rcv, w, 1, iw, 1,
898  $ info )
899  CALL chkxer( 'DTGSEN', infot, nout, lerr, ok )
900  infot = 9
901  CALL dtgsen( 1, .true., .true., sel, 1, a, 1, b, 0, r1, r2, r3,
902  $ q, 1, z, 1, m, tola, tolb, rcv, w, 1, iw, 1,
903  $ info )
904  CALL chkxer( 'DTGSEN', infot, nout, lerr, ok )
905  infot = 14
906  CALL dtgsen( 1, .true., .true., sel, 1, a, 1, b, 1, r1, r2, r3,
907  $ q, 0, z, 1, m, tola, tolb, rcv, w, 1, iw, 1,
908  $ info )
909  CALL chkxer( 'DTGSEN', infot, nout, lerr, ok )
910  infot = 16
911  CALL dtgsen( 1, .true., .true., sel, 1, a, 1, b, 1, r1, r2, r3,
912  $ q, 1, z, 0, m, tola, tolb, rcv, w, 1, iw, 1,
913  $ info )
914  CALL chkxer( 'DTGSEN', infot, nout, lerr, ok )
915  infot = 22
916  CALL dtgsen( 0, .true., .true., sel, 1, a, 1, b, 1, r1, r2, r3,
917  $ q, 1, z, 1, m, tola, tolb, rcv, w, 1, iw, 1,
918  $ info )
919  CALL chkxer( 'DTGSEN', infot, nout, lerr, ok )
920  infot = 22
921  CALL dtgsen( 1, .true., .true., sel, 1, a, 1, b, 1, r1, r2, r3,
922  $ q, 1, z, 1, m, tola, tolb, rcv, w, 1, iw, 1,
923  $ info )
924  CALL chkxer( 'DTGSEN', infot, nout, lerr, ok )
925  infot = 22
926  CALL dtgsen( 2, .true., .true., sel, 1, a, 1, b, 1, r1, r2, r3,
927  $ q, 1, z, 1, m, tola, tolb, rcv, w, 1, iw, 1,
928  $ info )
929  CALL chkxer( 'DTGSEN', infot, nout, lerr, ok )
930  infot = 24
931  CALL dtgsen( 0, .true., .true., sel, 1, a, 1, b, 1, r1, r2, r3,
932  $ q, 1, z, 1, m, tola, tolb, rcv, w, 20, iw, 0,
933  $ info )
934  CALL chkxer( 'DTGSEN', infot, nout, lerr, ok )
935  infot = 24
936  CALL dtgsen( 1, .true., .true., sel, 1, a, 1, b, 1, r1, r2, r3,
937  $ q, 1, z, 1, m, tola, tolb, rcv, w, 20, iw, 0,
938  $ info )
939  CALL chkxer( 'DTGSEN', infot, nout, lerr, ok )
940  infot = 24
941  CALL dtgsen( 2, .true., .true., sel, 1, a, 1, b, 1, r1, r2, r3,
942  $ q, 1, z, 1, m, tola, tolb, rcv, w, 20, iw, 1,
943  $ info )
944  CALL chkxer( 'DTGSEN', infot, nout, lerr, ok )
945  nt = nt + 12
946 *
947 * DTGSNA
948 *
949  srnamt = 'DTGSNA'
950  infot = 1
951  CALL dtgsna( '/', 'A', sel, 1, a, 1, b, 1, q, 1, u, 1, r1, r2,
952  $ 1, m, w, 1, iw, info )
953  CALL chkxer( 'DTGSNA', infot, nout, lerr, ok )
954  infot = 2
955  CALL dtgsna( 'B', '/', sel, 1, a, 1, b, 1, q, 1, u, 1, r1, r2,
956  $ 1, m, w, 1, iw, info )
957  CALL chkxer( 'DTGSNA', infot, nout, lerr, ok )
958  infot = 4
959  CALL dtgsna( 'B', 'A', sel, -1, a, 1, b, 1, q, 1, u, 1, r1, r2,
960  $ 1, m, w, 1, iw, info )
961  CALL chkxer( 'DTGSNA', infot, nout, lerr, ok )
962  infot = 6
963  CALL dtgsna( 'B', 'A', sel, 1, a, 0, b, 1, q, 1, u, 1, r1, r2,
964  $ 1, m, w, 1, iw, info )
965  CALL chkxer( 'DTGSNA', infot, nout, lerr, ok )
966  infot = 8
967  CALL dtgsna( 'B', 'A', sel, 1, a, 1, b, 0, q, 1, u, 1, r1, r2,
968  $ 1, m, w, 1, iw, info )
969  CALL chkxer( 'DTGSNA', infot, nout, lerr, ok )
970  infot = 10
971  CALL dtgsna( 'E', 'A', sel, 1, a, 1, b, 1, q, 0, u, 1, r1, r2,
972  $ 1, m, w, 1, iw, info )
973  CALL chkxer( 'DTGSNA', infot, nout, lerr, ok )
974  infot = 12
975  CALL dtgsna( 'E', 'A', sel, 1, a, 1, b, 1, q, 1, u, 0, r1, r2,
976  $ 1, m, w, 1, iw, info )
977  CALL chkxer( 'DTGSNA', infot, nout, lerr, ok )
978  infot = 15
979  CALL dtgsna( 'E', 'A', sel, 1, a, 1, b, 1, q, 1, u, 1, r1, r2,
980  $ 0, m, w, 1, iw, info )
981  CALL chkxer( 'DTGSNA', infot, nout, lerr, ok )
982  infot = 18
983  CALL dtgsna( 'E', 'A', sel, 1, a, 1, b, 1, q, 1, u, 1, r1, r2,
984  $ 1, m, w, 0, iw, info )
985  CALL chkxer( 'DTGSNA', infot, nout, lerr, ok )
986  nt = nt + 9
987 *
988 * DTGSYL
989 *
990  srnamt = 'DTGSYL'
991  infot = 1
992  CALL dtgsyl( '/', 0, 1, 1, a, 1, b, 1, q, 1, u, 1, v, 1, z, 1,
993  $ scale, dif, w, 1, iw, info )
994  CALL chkxer( 'DTGSYL', infot, nout, lerr, ok )
995  infot = 2
996  CALL dtgsyl( 'N', -1, 1, 1, a, 1, b, 1, q, 1, u, 1, v, 1, z, 1,
997  $ scale, dif, w, 1, iw, info )
998  CALL chkxer( 'DTGSYL', infot, nout, lerr, ok )
999  infot = 3
1000  CALL dtgsyl( 'N', 0, 0, 1, a, 1, b, 1, q, 1, u, 1, v, 1, z, 1,
1001  $ scale, dif, w, 1, iw, info )
1002  CALL chkxer( 'DTGSYL', infot, nout, lerr, ok )
1003  infot = 4
1004  CALL dtgsyl( 'N', 0, 1, 0, a, 1, b, 1, q, 1, u, 1, v, 1, z, 1,
1005  $ scale, dif, w, 1, iw, info )
1006  CALL chkxer( 'DTGSYL', infot, nout, lerr, ok )
1007  infot = 6
1008  CALL dtgsyl( 'N', 0, 1, 1, a, 0, b, 1, q, 1, u, 1, v, 1, z, 1,
1009  $ scale, dif, w, 1, iw, info )
1010  CALL chkxer( 'DTGSYL', infot, nout, lerr, ok )
1011  infot = 8
1012  CALL dtgsyl( 'N', 0, 1, 1, a, 1, b, 0, q, 1, u, 1, v, 1, z, 1,
1013  $ scale, dif, w, 1, iw, info )
1014  CALL chkxer( 'DTGSYL', infot, nout, lerr, ok )
1015  infot = 10
1016  CALL dtgsyl( 'N', 0, 1, 1, a, 1, b, 1, q, 0, u, 1, v, 1, z, 1,
1017  $ scale, dif, w, 1, iw, info )
1018  CALL chkxer( 'DTGSYL', infot, nout, lerr, ok )
1019  infot = 12
1020  CALL dtgsyl( 'N', 0, 1, 1, a, 1, b, 1, q, 1, u, 0, v, 1, z, 1,
1021  $ scale, dif, w, 1, iw, info )
1022  CALL chkxer( 'DTGSYL', infot, nout, lerr, ok )
1023  infot = 14
1024  CALL dtgsyl( 'N', 0, 1, 1, a, 1, b, 1, q, 1, u, 1, v, 0, z, 1,
1025  $ scale, dif, w, 1, iw, info )
1026  CALL chkxer( 'DTGSYL', infot, nout, lerr, ok )
1027  infot = 16
1028  CALL dtgsyl( 'N', 0, 1, 1, a, 1, b, 1, q, 1, u, 1, v, 1, z, 0,
1029  $ scale, dif, w, 1, iw, info )
1030  CALL chkxer( 'DTGSYL', infot, nout, lerr, ok )
1031  infot = 20
1032  CALL dtgsyl( 'N', 1, 1, 1, a, 1, b, 1, q, 1, u, 1, v, 1, z, 1,
1033  $ scale, dif, w, 1, iw, info )
1034  CALL chkxer( 'DTGSYL', infot, nout, lerr, ok )
1035  infot = 20
1036  CALL dtgsyl( 'N', 2, 1, 1, a, 1, b, 1, q, 1, u, 1, v, 1, z, 1,
1037  $ scale, dif, w, 1, iw, info )
1038  CALL chkxer( 'DTGSYL', infot, nout, lerr, ok )
1039  nt = nt + 12
1040  END IF
1041 *
1042 * Print a summary line.
1043 *
1044  IF( ok ) THEN
1045  WRITE( nout, fmt = 9999 )path, nt
1046  ELSE
1047  WRITE( nout, fmt = 9998 )path
1048  END IF
1049 *
1050  9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits (',
1051  $ i3, ' tests done)' )
1052  9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
1053  $ 'exits ***' )
1054 *
1055  RETURN
1056 *
1057 * End of DERRGG
1058 *
1059  END
subroutine dggesx(JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, RCONDE, RCONDV, WORK, LWORK, IWORK, LIWORK, BWORK, INFO)
DGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE...
Definition: dggesx.f:367
subroutine dgges(JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, WORK, LWORK, BWORK, INFO)
DGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
Definition: dgges.f:286
subroutine dtgsna(JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, LDVL, VR, LDVR, S, DIF, MM, M, WORK, LWORK, IWORK, INFO)
DTGSNA
Definition: dtgsna.f:383
subroutine dtgsja(JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, LDB, TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK, NCYCLE, INFO)
DTGSJA
Definition: dtgsja.f:380
subroutine dgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
DGGHRD
Definition: dgghrd.f:209
subroutine dggrqf(M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK, LWORK, INFO)
DGGRQF
Definition: dggrqf.f:216
recursive subroutine dorcsd(JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21, LDX21, X22, LDX22, THETA, U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, LDV2T, WORK, LWORK, IWORK, INFO)
DORCSD
Definition: dorcsd.f:302
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine dggsvd(JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK, IWORK, INFO)
DGGSVD computes the singular value decomposition (SVD) for OTHER matrices
Definition: dggsvd.f:334
subroutine derrgg(PATH, NUNIT)
DERRGG
Definition: derrgg.f:58
subroutine dggglm(N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, INFO)
DGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: dggglm.f:187
subroutine dhgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
DHGEQZ
Definition: dhgeqz.f:306
subroutine dggqrf(N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, LWORK, INFO)
DGGQRF
Definition: dggqrf.f:217
subroutine dggsvp(JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, TAU, WORK, INFO)
DGGSVP
Definition: dggsvp.f:256
subroutine dtgexc(WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, IFST, ILST, WORK, LWORK, INFO)
DTGEXC
Definition: dtgexc.f:222
subroutine dtgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
DTGEVC
Definition: dtgevc.f:297
subroutine dgglse(M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, INFO)
DGGLSE solves overdetermined or underdetermined systems for OTHER matrices
Definition: dgglse.f:182
subroutine dtgsen(IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO)
DTGSEN
Definition: dtgsen.f:454
subroutine dggev(JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO)
DGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: dggev.f:228
subroutine dggevx(BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, WORK, LWORK, IWORK, BWORK, INFO)
DGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: dggevx.f:393
subroutine dtgsyl(TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK, IWORK, INFO)
DTGSYL
Definition: dtgsyl.f:301