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