57
58
59
60
61
62
63 CHARACTER*3 PATH
64 INTEGER NUNIT
65
66
67
68
69
70 INTEGER NMAX, LW
71 parameter( nmax = 3, lw = 6*nmax )
72 REAL ONE, ZERO
73 parameter( one = 1.0e+0, zero = 0.0e+0 )
74
75
76 CHARACTER*2 C2
77 INTEGER DUMMYK, DUMMYL, I, IFST, IHI, ILO, ILST, INFO,
78 $ J, M, NCYCLE, NT, SDIM, LWORK
79 REAL ANRM, BNRM, DIF, SCALE, TOLA, TOLB
80
81
82 LOGICAL BW( NMAX ), SEL( NMAX )
83 INTEGER IW( LW ), IDUM(NMAX)
84 REAL LS( NMAX ), R1( NMAX ), R2( NMAX ),
85 $ RCE( NMAX ), RCV( NMAX ), RS( NMAX ), RW( LW )
86 COMPLEX A( NMAX, NMAX ), ALPHA( NMAX ),
87 $ B( NMAX, NMAX ), BETA( NMAX ), Q( NMAX, NMAX ),
88 $ TAU( NMAX ), U( NMAX, NMAX ), V( NMAX, NMAX ),
89 $ W( LW ), Z( NMAX, NMAX )
90
91
92 LOGICAL CLCTES, CLCTSX, LSAMEN
94
95
101
102
103 LOGICAL LERR, OK
104 CHARACTER*32 SRNAMT
105 INTEGER INFOT, NOUT
106
107
108 COMMON / infoc / infot, nout, ok, lerr
109 COMMON / srnamc / srnamt
110
111
112
113 nout = nunit
114 WRITE( nout, fmt = * )
115 c2 = path( 2: 3 )
116
117
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.0e0
132 tolb = 1.0e0
133 ifst = 1
134 ilst = 1
135 nt = 0
136 lwork = 1
137
138
139
145
146
147
148 IF(
lsamen( 2, c2,
'GG' ) )
THEN
149
150
151
152 srnamt = 'CGGHRD'
153 infot = 1
154 CALL cgghrd(
'/',
'N', 0, 1, 0, a, 1, b, 1, q, 1, z, 1, info )
155 CALL chkxer(
'CGGHRD', infot, nout, lerr, ok )
156 infot = 2
157 CALL cgghrd(
'N',
'/', 0, 1, 0, a, 1, b, 1, q, 1, z, 1, info )
158 CALL chkxer(
'CGGHRD', infot, nout, lerr, ok )
159 infot = 3
160 CALL cgghrd(
'N',
'N', -1, 0, 0, a, 1, b, 1, q, 1, z, 1, info )
161 CALL chkxer(
'CGGHRD', infot, nout, lerr, ok )
162 infot = 4
163 CALL cgghrd(
'N',
'N', 0, 0, 0, a, 1, b, 1, q, 1, z, 1, info )
164 CALL chkxer(
'CGGHRD', infot, nout, lerr, ok )
165 infot = 5
166 CALL cgghrd(
'N',
'N', 0, 1, 1, a, 1, b, 1, q, 1, z, 1, info )
167 CALL chkxer(
'CGGHRD', infot, nout, lerr, ok )
168 infot = 7
169 CALL cgghrd(
'N',
'N', 2, 1, 1, a, 1, b, 2, q, 1, z, 1, info )
170 CALL chkxer(
'CGGHRD', infot, nout, lerr, ok )
171 infot = 9
172 CALL cgghrd(
'N',
'N', 2, 1, 1, a, 2, b, 1, q, 1, z, 1, info )
173 CALL chkxer(
'CGGHRD', infot, nout, lerr, ok )
174 infot = 11
175 CALL cgghrd(
'V',
'N', 2, 1, 1, a, 2, b, 2, q, 1, z, 1, info )
176 CALL chkxer(
'CGGHRD', infot, nout, lerr, ok )
177 infot = 13
178 CALL cgghrd(
'N',
'V', 2, 1, 1, a, 2, b, 2, q, 1, z, 1, info )
179 CALL chkxer(
'CGGHRD', infot, nout, lerr, ok )
180 nt = nt + 9
181
182
183
184 srnamt = 'CGGHD3'
185 infot = 1
186 CALL cgghd3(
'/',
'N', 0, 1, 0, a, 1, b, 1, q, 1, z, 1, w, lw,
187 $ info )
188 CALL chkxer(
'CGGHD3', infot, nout, lerr, ok )
189 infot = 2
190 CALL cgghd3(
'N',
'/', 0, 1, 0, a, 1, b, 1, q, 1, z, 1, w, lw,
191 $ info )
192 CALL chkxer(
'CGGHD3', infot, nout, lerr, ok )
193 infot = 3
194 CALL cgghd3(
'N',
'N', -1, 0, 0, a, 1, b, 1, q, 1, z, 1, w, lw,
195 $ info )
196 CALL chkxer(
'CGGHD3', infot, nout, lerr, ok )
197 infot = 4
198 CALL cgghd3(
'N',
'N', 0, 0, 0, a, 1, b, 1, q, 1, z, 1, w, lw,
199 $ info )
200 CALL chkxer(
'CGGHD3', infot, nout, lerr, ok )
201 infot = 5
202 CALL cgghd3(
'N',
'N', 0, 1, 1, a, 1, b, 1, q, 1, z, 1, w, lw,
203 $ info )
204 CALL chkxer(
'CGGHD3', infot, nout, lerr, ok )
205 infot = 7
206 CALL cgghd3(
'N',
'N', 2, 1, 1, a, 1, b, 2, q, 1, z, 1, w, lw,
207 $ info )
208 CALL chkxer(
'CGGHD3', infot, nout, lerr, ok )
209 infot = 9
210 CALL cgghd3(
'N',
'N', 2, 1, 1, a, 2, b, 1, q, 1, z, 1, w, lw,
211 $ info )
212 CALL chkxer(
'CGGHD3', infot, nout, lerr, ok )
213 infot = 11
214 CALL cgghd3(
'V',
'N', 2, 1, 1, a, 2, b, 2, q, 1, z, 1, w, lw,
215 $ info )
216 CALL chkxer(
'CGGHD3', infot, nout, lerr, ok )
217 infot = 13
218 CALL cgghd3(
'N',
'V', 2, 1, 1, a, 2, b, 2, q, 1, z, 1, w, lw,
219 $ info )
220 CALL chkxer(
'CGGHD3', infot, nout, lerr, ok )
221 nt = nt + 9
222
223
224
225 srnamt = 'CHGEQZ'
226 infot = 1
227 CALL chgeqz(
'/',
'N',
'N', 0, 1, 0, a, 1, b, 1, alpha, beta,
228 $ q, 1, z, 1, w, 1, rw, info )
229 CALL chkxer(
'CHGEQZ', infot, nout, lerr, ok )
230 infot = 2
231 CALL chgeqz(
'E',
'/',
'N', 0, 1, 0, a, 1, b, 1, alpha, beta,
232 $ q, 1, z, 1, w, 1, rw, info )
233 CALL chkxer(
'CHGEQZ', infot, nout, lerr, ok )
234 infot = 3
235 CALL chgeqz(
'E',
'N',
'/', 0, 1, 0, a, 1, b, 1, alpha, beta,
236 $ q, 1, z, 1, w, 1, rw, info )
237 CALL chkxer(
'CHGEQZ', infot, nout, lerr, ok )
238 infot = 4
239 CALL chgeqz(
'E',
'N',
'N', -1, 0, 0, a, 1, b, 1, alpha, beta,
240 $ q, 1, z, 1, w, 1, rw, info )
241 CALL chkxer(
'CHGEQZ', infot, nout, lerr, ok )
242 infot = 5
243 CALL chgeqz(
'E',
'N',
'N', 0, 0, 0, a, 1, b, 1, alpha, beta,
244 $ q, 1, z, 1, w, 1, rw, info )
245 CALL chkxer(
'CHGEQZ', infot, nout, lerr, ok )
246 infot = 6
247 CALL chgeqz(
'E',
'N',
'N', 0, 1, 1, a, 1, b, 1, alpha, beta,
248 $ q, 1, z, 1, w, 1, rw, info )
249 CALL chkxer(
'CHGEQZ', infot, nout, lerr, ok )
250 infot = 8
251 CALL chgeqz(
'E',
'N',
'N', 2, 1, 1, a, 1, b, 2, alpha, beta,
252 $ q, 1, z, 1, w, 1, rw, info )
253 CALL chkxer(
'CHGEQZ', infot, nout, lerr, ok )
254 infot = 10
255 CALL chgeqz(
'E',
'N',
'N', 2, 1, 1, a, 2, b, 1, alpha, beta,
256 $ q, 1, z, 1, w, 1, rw, info )
257 CALL chkxer(
'CHGEQZ', infot, nout, lerr, ok )
258 infot = 14
259 CALL chgeqz(
'E',
'V',
'N', 2, 1, 1, a, 2, b, 2, alpha, beta,
260 $ q, 1, z, 1, w, 1, rw, info )
261 CALL chkxer(
'CHGEQZ', infot, nout, lerr, ok )
262 infot = 16
263 CALL chgeqz(
'E',
'N',
'V', 2, 1, 1, a, 2, b, 2, alpha, beta,
264 $ q, 1, z, 1, w, 1, rw, info )
265 CALL chkxer(
'CHGEQZ', infot, nout, lerr, ok )
266 nt = nt + 10
267
268
269
270 srnamt = 'CTGEVC'
271 infot = 1
272 CALL ctgevc(
'/',
'A', sel, 0, a, 1, b, 1, q, 1, z, 1, 0, m, w,
273 $ rw, info )
274 CALL chkxer(
'CTGEVC', infot, nout, lerr, ok )
275 infot = 2
276 CALL ctgevc(
'R',
'/', sel, 0, a, 1, b, 1, q, 1, z, 1, 0, m, w,
277 $ rw, info )
278 CALL chkxer(
'CTGEVC', infot, nout, lerr, ok )
279 infot = 4
280 CALL ctgevc(
'R',
'A', sel, -1, a, 1, b, 1, q, 1, z, 1, 0, m,
281 $ w, rw, info )
282 CALL chkxer(
'CTGEVC', infot, nout, lerr, ok )
283 infot = 6
284 CALL ctgevc(
'R',
'A', sel, 2, a, 1, b, 2, q, 1, z, 2, 0, m, w,
285 $ rw, info )
286 CALL chkxer(
'CTGEVC', infot, nout, lerr, ok )
287 infot = 8
288 CALL ctgevc(
'R',
'A', sel, 2, a, 2, b, 1, q, 1, z, 2, 0, m, w,
289 $ rw, info )
290 CALL chkxer(
'CTGEVC', infot, nout, lerr, ok )
291 infot = 10
292 CALL ctgevc(
'L',
'A', sel, 2, a, 2, b, 2, q, 1, z, 1, 0, m, w,
293 $ rw, info )
294 CALL chkxer(
'CTGEVC', infot, nout, lerr, ok )
295 infot = 12
296 CALL ctgevc(
'R',
'A', sel, 2, a, 2, b, 2, q, 1, z, 1, 0, m, w,
297 $ rw, info )
298 CALL chkxer(
'CTGEVC', infot, nout, lerr, ok )
299 infot = 13
300 CALL ctgevc(
'R',
'A', sel, 2, a, 2, b, 2, q, 1, z, 2, 1, m, w,
301 $ rw, info )
302 CALL chkxer(
'CTGEVC', infot, nout, lerr, ok )
303 nt = nt + 8
304
305
306
307 ELSE IF(
lsamen( 3, path,
'GSV' ) )
THEN
308
309
310
311 srnamt = 'CGGSVD3'
312 infot = 1
313 CALL cggsvd3(
'/',
'N',
'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
314 $ 1, r1, r2, u, 1, v, 1, q, 1, w, lwork, rw, idum,
315 $ info )
316 CALL chkxer(
'CGGSVD3', infot, nout, lerr, ok )
317 infot = 2
318 CALL cggsvd3(
'N',
'/',
'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
319 $ 1, r1, r2, u, 1, v, 1, q, 1, w, lwork, rw, idum,
320 $ info )
321 CALL chkxer(
'CGGSVD3', infot, nout, lerr, ok )
322 infot = 3
323 CALL cggsvd3(
'N',
'N',
'/', 0, 0, 0, dummyk, dummyl, a, 1, b,
324 $ 1, r1, r2, u, 1, v, 1, q, 1, w, lwork, rw, idum,
325 $ info )
326 CALL chkxer(
'CGGSVD3', infot, nout, lerr, ok )
327 infot = 4
328 CALL cggsvd3(
'N',
'N',
'N', -1, 0, 0, dummyk, dummyl, a, 1, b,
329 $ 1, r1, r2, u, 1, v, 1, q, 1, w, lwork, rw, idum,
330 $ info )
331 CALL chkxer(
'CGGSVD3', infot, nout, lerr, ok )
332 infot = 5
333 CALL cggsvd3(
'N',
'N',
'N', 0, -1, 0, dummyk, dummyl, a, 1, b,
334 $ 1, r1, r2, u, 1, v, 1, q, 1, w, lwork, rw, idum,
335 $ info )
336 CALL chkxer(
'CGGSVD3', infot, nout, lerr, ok )
337 infot = 6
338 CALL cggsvd3(
'N',
'N',
'N', 0, 0, -1, dummyk, dummyl, a, 1, b,
339 $ 1, r1, r2, u, 1, v, 1, q, 1, w, lwork, rw, idum,
340 $ info )
341 CALL chkxer(
'CGGSVD3', infot, nout, lerr, ok )
342 infot = 10
343 CALL cggsvd3(
'N',
'N',
'N', 2, 1, 1, dummyk, dummyl, a, 1, b,
344 $ 1, r1, r2, u, 1, v, 1, q, 1, w, lwork, rw, idum,
345 $ info )
346 CALL chkxer(
'CGGSVD3', infot, nout, lerr, ok )
347 infot = 12
348 CALL cggsvd3(
'N',
'N',
'N', 1, 1, 2, dummyk, dummyl, a, 1, b,
349 $ 1, r1, r2, u, 1, v, 1, q, 1, w, lwork, rw, idum,
350 $ info )
351 CALL chkxer(
'CGGSVD3', infot, nout, lerr, ok )
352 infot = 16
353 CALL cggsvd3(
'U',
'N',
'N', 2, 2, 2, dummyk, dummyl, a, 2, b,
354 $ 2, r1, r2, u, 1, v, 1, q, 1, w, lwork, rw, idum,
355 $ info )
356 CALL chkxer(
'CGGSVD3', infot, nout, lerr, ok )
357 infot = 18
358 CALL cggsvd3(
'N',
'V',
'N', 2, 2, 2, dummyk, dummyl, a, 2, b,
359 $ 2, r1, r2, u, 2, v, 1, q, 1, w, lwork, rw, idum,
360 $ info )
361 CALL chkxer(
'CGGSVD3', infot, nout, lerr, ok )
362 infot = 20
363 CALL cggsvd3(
'N',
'N',
'Q', 2, 2, 2, dummyk, dummyl, a, 2, b,
364 $ 2, r1, r2, u, 2, v, 2, q, 1, w, lwork, rw, idum,
365 $ info )
366 CALL chkxer(
'CGGSVD3', infot, nout, lerr, ok )
367 nt = nt + 11
368
369
370
371 srnamt = 'CGGSVP3'
372 infot = 1
373 CALL cggsvp3(
'/',
'N',
'N', 0, 0, 0, a, 1, b, 1, tola, tolb,
374 $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, rw, tau, w,
375 $ lwork, info )
376 CALL chkxer(
'CGGSVP3', infot, nout, lerr, ok )
377 infot = 2
378 CALL cggsvp3(
'N',
'/',
'N', 0, 0, 0, a, 1, b, 1, tola, tolb,
379 $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, rw, tau, w,
380 $ lwork, info )
381 CALL chkxer(
'CGGSVP3', infot, nout, lerr, ok )
382 infot = 3
383 CALL cggsvp3(
'N',
'N',
'/', 0, 0, 0, a, 1, b, 1, tola, tolb,
384 $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, rw, tau, w,
385 $ lwork, info )
386 CALL chkxer(
'CGGSVP3', infot, nout, lerr, ok )
387 infot = 4
388 CALL cggsvp3(
'N',
'N',
'N', -1, 0, 0, a, 1, b, 1, tola, tolb,
389 $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, rw, tau, w,
390 $ lwork, info )
391 CALL chkxer(
'CGGSVP3', infot, nout, lerr, ok )
392 infot = 5
393 CALL cggsvp3(
'N',
'N',
'N', 0, -1, 0, a, 1, b, 1, tola, tolb,
394 $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, rw, tau, w,
395 $ lwork, info )
396 CALL chkxer(
'CGGSVP3', infot, nout, lerr, ok )
397 infot = 6
398 CALL cggsvp3(
'N',
'N',
'N', 0, 0, -1, a, 1, b, 1, tola, tolb,
399 $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, rw, tau, w,
400 $ lwork, info )
401 CALL chkxer(
'CGGSVP3', infot, nout, lerr, ok )
402 infot = 8
403 CALL cggsvp3(
'N',
'N',
'N', 2, 1, 1, a, 1, b, 1, tola, tolb,
404 $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, rw, tau, w,
405 $ lwork, info )
406 CALL chkxer(
'CGGSVP3', infot, nout, lerr, ok )
407 infot = 10
408 CALL cggsvp3(
'N',
'N',
'N', 1, 2, 1, a, 1, b, 1, tola, tolb,
409 $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, rw, tau, w,
410 $ lwork, info )
411 CALL chkxer(
'CGGSVP3', infot, nout, lerr, ok )
412 infot = 16
413 CALL cggsvp3(
'U',
'N',
'N', 2, 2, 2, a, 2, b, 2, tola, tolb,
414 $ dummyk, dummyl, u, 1, v, 1, q, 1, iw, rw, tau, w,
415 $ lwork, info )
416 CALL chkxer(
'CGGSVP3', infot, nout, lerr, ok )
417 infot = 18
418 CALL cggsvp3(
'N',
'V',
'N', 2, 2, 2, a, 2, b, 2, tola, tolb,
419 $ dummyk, dummyl, u, 2, v, 1, q, 1, iw, rw, tau, w,
420 $ lwork, info )
421 CALL chkxer(
'CGGSVP3', infot, nout, lerr, ok )
422 infot = 20
423 CALL cggsvp3(
'N',
'N',
'Q', 2, 2, 2, a, 2, b, 2, tola, tolb,
424 $ dummyk, dummyl, u, 2, v, 2, q, 1, iw, rw, tau, w,
425 $ lwork, info )
426 CALL chkxer(
'CGGSVP3', infot, nout, lerr, ok )
427 nt = nt + 11
428
429
430
431 srnamt = 'CTGSJA'
432 infot = 1
433 CALL ctgsja(
'/',
'N',
'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
434 $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
435 $ ncycle, info )
436 CALL chkxer(
'CTGSJA', infot, nout, lerr, ok )
437 infot = 2
438 CALL ctgsja(
'N',
'/',
'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
439 $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
440 $ ncycle, info )
441 CALL chkxer(
'CTGSJA', infot, nout, lerr, ok )
442 infot = 3
443 CALL ctgsja(
'N',
'N',
'/', 0, 0, 0, dummyk, dummyl, a, 1, b,
444 $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
445 $ ncycle, info )
446 CALL chkxer(
'CTGSJA', infot, nout, lerr, ok )
447 infot = 4
448 CALL ctgsja(
'N',
'N',
'N', -1, 0, 0, dummyk, dummyl, a, 1, b,
449 $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
450 $ ncycle, info )
451 CALL chkxer(
'CTGSJA', infot, nout, lerr, ok )
452 infot = 5
453 CALL ctgsja(
'N',
'N',
'N', 0, -1, 0, dummyk, dummyl, a, 1, b,
454 $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
455 $ ncycle, info )
456 CALL chkxer(
'CTGSJA', infot, nout, lerr, ok )
457 infot = 6
458 CALL ctgsja(
'N',
'N',
'N', 0, 0, -1, dummyk, dummyl, a, 1, b,
459 $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
460 $ ncycle, info )
461 CALL chkxer(
'CTGSJA', infot, nout, lerr, ok )
462 infot = 10
463 CALL ctgsja(
'N',
'N',
'N', 0, 0, 0, dummyk, dummyl, a, 0, b,
464 $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
465 $ ncycle, info )
466 CALL chkxer(
'CTGSJA', infot, nout, lerr, ok )
467 infot = 12
468 CALL ctgsja(
'N',
'N',
'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
469 $ 0, tola, tolb, r1, r2, u, 1, v, 1, q, 1, w,
470 $ ncycle, info )
471 CALL chkxer(
'CTGSJA', infot, nout, lerr, ok )
472 infot = 18
473 CALL ctgsja(
'U',
'N',
'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
474 $ 1, tola, tolb, r1, r2, u, 0, v, 1, q, 1, w,
475 $ ncycle, info )
476 CALL chkxer(
'CTGSJA', infot, nout, lerr, ok )
477 infot = 20
478 CALL ctgsja(
'N',
'V',
'N', 0, 0, 0, dummyk, dummyl, a, 1, b,
479 $ 1, tola, tolb, r1, r2, u, 1, v, 0, q, 1, w,
480 $ ncycle, info )
481 CALL chkxer(
'CTGSJA', infot, nout, lerr, ok )
482 infot = 22
483 CALL ctgsja(
'N',
'N',
'Q', 0, 0, 0, dummyk, dummyl, a, 1, b,
484 $ 1, tola, tolb, r1, r2, u, 1, v, 1, q, 0, w,
485 $ ncycle, info )
486 CALL chkxer(
'CTGSJA', infot, nout, lerr, ok )
487 nt = nt + 11
488
489
490
491 ELSE IF(
lsamen( 3, path,
'GLM' ) )
THEN
492
493
494
495 srnamt = 'CGGGLM'
496 infot = 1
497 CALL cggglm( -1, 0, 0, a, 1, b, 1, tau, alpha, beta, w, lw,
498 $ info )
499 CALL chkxer(
'CGGGLM', infot, nout, lerr, ok )
500 infot = 2
501 CALL cggglm( 0, -1, 0, a, 1, b, 1, tau, alpha, beta, w, lw,
502 $ info )
503 CALL chkxer(
'CGGGLM', infot, nout, lerr, ok )
504 infot = 2
505 CALL cggglm( 0, 1, 0, a, 1, b, 1, tau, alpha, beta, w, lw,
506 $ info )
507 CALL chkxer(
'CGGGLM', infot, nout, lerr, ok )
508 infot = 3
509 CALL cggglm( 0, 0, -1, a, 1, b, 1, tau, alpha, beta, w, lw,
510 $ info )
511 CALL chkxer(
'CGGGLM', infot, nout, lerr, ok )
512 infot = 3
513 CALL cggglm( 1, 0, 0, a, 1, b, 1, tau, alpha, beta, w, lw,
514 $ info )
515 CALL chkxer(
'CGGGLM', infot, nout, lerr, ok )
516 infot = 5
517 CALL cggglm( 0, 0, 0, a, 0, b, 1, tau, alpha, beta, w, lw,
518 $ info )
519 CALL chkxer(
'CGGGLM', infot, nout, lerr, ok )
520 infot = 7
521 CALL cggglm( 0, 0, 0, a, 1, b, 0, tau, alpha, beta, w, lw,
522 $ info )
523 CALL chkxer(
'CGGGLM', infot, nout, lerr, ok )
524 infot = 12
525 CALL cggglm( 1, 1, 1, a, 1, b, 1, tau, alpha, beta, w, 1,
526 $ info )
527 CALL chkxer(
'CGGGLM', infot, nout, lerr, ok )
528 nt = nt + 8
529
530
531
532 ELSE IF(
lsamen( 3, path,
'LSE' ) )
THEN
533
534
535
536 srnamt = 'CGGLSE'
537 infot = 1
538 CALL cgglse( -1, 0, 0, a, 1, b, 1, tau, alpha, beta, w, lw,
539 $ info )
540 CALL chkxer(
'CGGLSE', infot, nout, lerr, ok )
541 infot = 2
542 CALL cgglse( 0, -1, 0, a, 1, b, 1, tau, alpha, beta, w, lw,
543 $ info )
544 CALL chkxer(
'CGGLSE', infot, nout, lerr, ok )
545 infot = 3
546 CALL cgglse( 0, 0, -1, a, 1, b, 1, tau, alpha, beta, w, lw,
547 $ info )
548 CALL chkxer(
'CGGLSE', infot, nout, lerr, ok )
549 infot = 3
550 CALL cgglse( 0, 0, 1, a, 1, b, 1, tau, alpha, beta, w, lw,
551 $ info )
552 CALL chkxer(
'CGGLSE', infot, nout, lerr, ok )
553 infot = 3
554 CALL cgglse( 0, 1, 0, a, 1, b, 1, tau, alpha, beta, w, lw,
555 $ info )
556 CALL chkxer(
'CGGLSE', infot, nout, lerr, ok )
557 infot = 5
558 CALL cgglse( 0, 0, 0, a, 0, b, 1, tau, alpha, beta, w, lw,
559 $ info )
560 CALL chkxer(
'CGGLSE', infot, nout, lerr, ok )
561 infot = 7
562 CALL cgglse( 0, 0, 0, a, 1, b, 0, tau, alpha, beta, w, lw,
563 $ info )
564 CALL chkxer(
'CGGLSE', infot, nout, lerr, ok )
565 infot = 12
566 CALL cgglse( 1, 1, 1, a, 1, b, 1, tau, alpha, beta, w, 1,
567 $ info )
568 CALL chkxer(
'CGGLSE', infot, nout, lerr, ok )
569 nt = nt + 8
570
571
572
573 ELSE IF(
lsamen( 3, path,
'CSD' ) )
THEN
574
575
576
577 srnamt = 'CUNCSD'
578 infot = 7
579 CALL cuncsd(
'Y',
'Y',
'Y',
'Y',
'N',
'N',
580 $ -1, 0, 0, a, 1, a,
581 $ 1, a, 1, a, 1, rs,
582 $ a, 1, a, 1, a, 1, a,
583 $ 1, w, lw, rw, lw, iw, info )
584 CALL chkxer(
'CUNCSD', infot, nout, lerr, ok )
585 infot = 8
586 CALL cuncsd(
'Y',
'Y',
'Y',
'Y',
'N',
'N',
587 $ 1, -1, 0, a, 1, a,
588 $ 1, a, 1, a, 1, rs,
589 $ a, 1, a, 1, a, 1, a,
590 $ 1, w, lw, rw, lw, iw, info )
591 CALL chkxer(
'CUNCSD', infot, nout, lerr, ok )
592 infot = 9
593 CALL cuncsd(
'Y',
'Y',
'Y',
'Y',
'N',
'N',
594 $ 1, 1, -1, a, 1, a,
595 $ 1, a, 1, a, 1, rs,
596 $ a, 1, a, 1, a, 1, a,
597 $ 1, w, lw, rw, lw, iw, info )
598 CALL chkxer(
'CUNCSD', infot, nout, lerr, ok )
599 infot = 11
600 CALL cuncsd(
'Y',
'Y',
'Y',
'Y',
'N',
'N',
601 $ 1, 1, 1, a, -1, a,
602 $ 1, a, 1, a, 1, rs,
603 $ a, 1, a, 1, a, 1, a,
604 $ 1, w, lw, rw, lw, iw, info )
605 CALL chkxer(
'CUNCSD', infot, nout, lerr, ok )
606 infot = 20
607 CALL cuncsd(
'Y',
'Y',
'Y',
'Y',
'N',
'N',
608 $ 1, 1, 1, a, 1, a,
609 $ 1, a, 1, a, 1, rs,
610 $ a, -1, a, 1, a, 1, a,
611 $ 1, w, lw, rw, lw, iw, info )
612 CALL chkxer(
'CUNCSD', infot, nout, lerr, ok )
613 infot = 22
614 CALL cuncsd(
'Y',
'Y',
'Y',
'Y',
'N',
'N',
615 $ 1, 1, 1, a, 1, a,
616 $ 1, a, 1, a, 1, rs,
617 $ a, 1, a, -1, a, 1, a,
618 $ 1, w, lw, rw, lw, iw, info )
619 CALL chkxer(
'CUNCSD', infot, nout, lerr, ok )
620 infot = 24
621 CALL cuncsd(
'Y',
'Y',
'Y',
'Y',
'N',
'N',
622 $ 1, 1, 1, a, 1, a,
623 $ 1, a, 1, a, 1, rs,
624 $ a, 1, a, 1, a, -1, a,
625 $ 1, w, lw, rw, lw, iw, info )
626 CALL chkxer(
'CUNCSD', infot, nout, lerr, ok )
627 infot = 26
628 CALL cuncsd(
'Y',
'Y',
'Y',
'Y',
'N',
'N',
629 $ 1, 1, 1, a, 1, a,
630 $ 1, a, 1, a, 1, rs,
631 $ a, 1, a, 1, a, 1, a,
632 $ -1, w, lw, rw, lw, iw, info )
633 CALL chkxer(
'CUNCSD', infot, nout, lerr, ok )
634 nt = nt + 8
635
636
637
638 ELSE IF(
lsamen( 3, path,
'GQR' ) )
THEN
639
640
641
642 srnamt = 'CGGQRF'
643 infot = 1
644 CALL cggqrf( -1, 0, 0, a, 1, alpha, b, 1, beta, w, lw, info )
645 CALL chkxer(
'CGGQRF', infot, nout, lerr, ok )
646 infot = 2
647 CALL cggqrf( 0, -1, 0, a, 1, alpha, b, 1, beta, w, lw, info )
648 CALL chkxer(
'CGGQRF', infot, nout, lerr, ok )
649 infot = 3
650 CALL cggqrf( 0, 0, -1, a, 1, alpha, b, 1, beta, w, lw, info )
651 CALL chkxer(
'CGGQRF', infot, nout, lerr, ok )
652 infot = 5
653 CALL cggqrf( 0, 0, 0, a, 0, alpha, b, 1, beta, w, lw, info )
654 CALL chkxer(
'CGGQRF', infot, nout, lerr, ok )
655 infot = 8
656 CALL cggqrf( 0, 0, 0, a, 1, alpha, b, 0, beta, w, lw, info )
657 CALL chkxer(
'CGGQRF', infot, nout, lerr, ok )
658 infot = 11
659 CALL cggqrf( 1, 1, 2, a, 1, alpha, b, 1, beta, w, 1, info )
660 CALL chkxer(
'CGGQRF', infot, nout, lerr, ok )
661 nt = nt + 6
662
663
664
665 srnamt = 'CGGRQF'
666 infot = 1
667 CALL cggrqf( -1, 0, 0, a, 1, alpha, b, 1, beta, w, lw, info )
668 CALL chkxer(
'CGGRQF', infot, nout, lerr, ok )
669 infot = 2
670 CALL cggrqf( 0, -1, 0, a, 1, alpha, b, 1, beta, w, lw, info )
671 CALL chkxer(
'CGGRQF', infot, nout, lerr, ok )
672 infot = 3
673 CALL cggrqf( 0, 0, -1, a, 1, alpha, b, 1, beta, w, lw, info )
674 CALL chkxer(
'CGGRQF', infot, nout, lerr, ok )
675 infot = 5
676 CALL cggrqf( 0, 0, 0, a, 0, alpha, b, 1, beta, w, lw, info )
677 CALL chkxer(
'CGGRQF', infot, nout, lerr, ok )
678 infot = 8
679 CALL cggrqf( 0, 0, 0, a, 1, alpha, b, 0, beta, w, lw, info )
680 CALL chkxer(
'CGGRQF', infot, nout, lerr, ok )
681 infot = 11
682 CALL cggrqf( 1, 1, 2, a, 1, alpha, b, 1, beta, w, 1, info )
683 CALL chkxer(
'CGGRQF', infot, nout, lerr, ok )
684 nt = nt + 6
685
686
687
688 ELSE IF(
lsamen( 3, path,
'CGS' ) .OR.
689 $
lsamen( 3, path,
'CGV' ) .OR.
690 $
lsamen( 3, path,
'CGX' ) .OR.
lsamen( 3, path,
'CXV' ) )
691 $ THEN
692
693
694
695 srnamt = 'CGGES '
696 infot = 1
697 CALL cgges(
'/',
'N',
'S',
clctes, 1, a, 1, b, 1, sdim, alpha,
698 $ beta, q, 1, u, 1, w, 1, rw, bw, info )
699 CALL chkxer(
'CGGES ', infot, nout, lerr, ok )
700 infot = 2
701 CALL cgges(
'N',
'/',
'S',
clctes, 1, a, 1, b, 1, sdim, alpha,
702 $ beta, q, 1, u, 1, w, 1, rw, bw, info )
703 CALL chkxer(
'CGGES ', infot, nout, lerr, ok )
704 infot = 3
705 CALL cgges(
'N',
'V',
'/',
clctes, 1, a, 1, b, 1, sdim, alpha,
706 $ beta, q, 1, u, 1, w, 1, rw, bw, info )
707 CALL chkxer(
'CGGES ', infot, nout, lerr, ok )
708 infot = 5
709 CALL cgges(
'N',
'V',
'S',
clctes, -1, a, 1, b, 1, sdim, alpha,
710 $ beta, q, 1, u, 1, w, 1, rw, bw, info )
711 CALL chkxer(
'CGGES ', infot, nout, lerr, ok )
712 infot = 7
713 CALL cgges(
'N',
'V',
'S',
clctes, 1, a, 0, b, 1, sdim, alpha,
714 $ beta, q, 1, u, 1, w, 1, rw, bw, info )
715 CALL chkxer(
'CGGES ', infot, nout, lerr, ok )
716 infot = 9
717 CALL cgges(
'N',
'V',
'S',
clctes, 1, a, 1, b, 0, sdim, alpha,
718 $ beta, q, 1, u, 1, w, 1, rw, bw, info )
719 CALL chkxer(
'CGGES ', infot, nout, lerr, ok )
720 infot = 14
721 CALL cgges(
'N',
'V',
'S',
clctes, 1, a, 1, b, 1, sdim, alpha,
722 $ beta, q, 0, u, 1, w, 1, rw, bw, info )
723 CALL chkxer(
'CGGES ', infot, nout, lerr, ok )
724 infot = 14
725 CALL cgges(
'V',
'V',
'S',
clctes, 2, a, 2, b, 2, sdim, alpha,
726 $ beta, q, 1, u, 2, w, 1, rw, bw, info )
727 CALL chkxer(
'CGGES ', infot, nout, lerr, ok )
728 infot = 16
729 CALL cgges(
'N',
'V',
'S',
clctes, 1, a, 1, b, 1, sdim, alpha,
730 $ beta, q, 1, u, 0, w, 1, rw, bw, info )
731 CALL chkxer(
'CGGES ', infot, nout, lerr, ok )
732 infot = 16
733 CALL cgges(
'V',
'V',
'S',
clctes, 2, a, 2, b, 2, sdim, alpha,
734 $ beta, q, 2, u, 1, w, 1, rw, bw, info )
735 CALL chkxer(
'CGGES ', infot, nout, lerr, ok )
736 infot = 18
737 CALL cgges(
'V',
'V',
'S',
clctes, 2, a, 2, b, 2, sdim, alpha,
738 $ beta, q, 2, u, 2, w, 1, rw, bw, info )
739 CALL chkxer(
'CGGES ', infot, nout, lerr, ok )
740 nt = nt + 11
741
742
743
744 srnamt = 'CGGES3'
745 infot = 1
746 CALL cgges3(
'/',
'N',
'S',
clctes, 1, a, 1, b, 1, sdim, alpha,
747 $ beta, q, 1, u, 1, w, 1, rw, bw, info )
748 CALL chkxer(
'CGGES3', infot, nout, lerr, ok )
749 infot = 2
750 CALL cgges3(
'N',
'/',
'S',
clctes, 1, a, 1, b, 1, sdim, alpha,
751 $ beta, q, 1, u, 1, w, 1, rw, bw, info )
752 CALL chkxer(
'CGGES3', infot, nout, lerr, ok )
753 infot = 3
754 CALL cgges3(
'N',
'V',
'/',
clctes, 1, a, 1, b, 1, sdim, alpha,
755 $ beta, q, 1, u, 1, w, 1, rw, bw, info )
756 CALL chkxer(
'CGGES3', infot, nout, lerr, ok )
757 infot = 5
758 CALL cgges3(
'N',
'V',
'S',
clctes, -1, a, 1, b, 1, sdim,
759 $ alpha, beta, q, 1, u, 1, w, 1, rw, bw, info )
760 CALL chkxer(
'CGGES3', infot, nout, lerr, ok )
761 infot = 7
762 CALL cgges3(
'N',
'V',
'S',
clctes, 1, a, 0, b, 1, sdim, alpha,
763 $ beta, q, 1, u, 1, w, 1, rw, bw, info )
764 CALL chkxer(
'CGGES3', infot, nout, lerr, ok )
765 infot = 9
766 CALL cgges3(
'N',
'V',
'S',
clctes, 1, a, 1, b, 0, sdim, alpha,
767 $ beta, q, 1, u, 1, w, 1, rw, bw, info )
768 CALL chkxer(
'CGGES3', infot, nout, lerr, ok )
769 infot = 14
770 CALL cgges3(
'N',
'V',
'S',
clctes, 1, a, 1, b, 1, sdim, alpha,
771 $ beta, q, 0, u, 1, w, 1, rw, bw, info )
772 CALL chkxer(
'CGGES3', infot, nout, lerr, ok )
773 infot = 14
774 CALL cgges3(
'V',
'V',
'S',
clctes, 2, a, 2, b, 2, sdim, alpha,
775 $ beta, q, 1, u, 2, w, 1, rw, bw, info )
776 CALL chkxer(
'CGGES3', infot, nout, lerr, ok )
777 infot = 16
778 CALL cgges3(
'N',
'V',
'S',
clctes, 1, a, 1, b, 1, sdim, alpha,
779 $ beta, q, 1, u, 0, w, 1, rw, bw, info )
780 CALL chkxer(
'CGGES3', infot, nout, lerr, ok )
781 infot = 16
782 CALL cgges3(
'V',
'V',
'S',
clctes, 2, a, 2, b, 2, sdim, alpha,
783 $ beta, q, 2, u, 1, w, 1, rw, bw, info )
784 CALL chkxer(
'CGGES3', infot, nout, lerr, ok )
785 infot = 18
786 CALL cgges3(
'V',
'V',
'S',
clctes, 2, a, 2, b, 2, sdim, alpha,
787 $ beta, q, 2, u, 2, w, 1, rw, bw, info )
788 CALL chkxer(
'CGGES3', infot, nout, lerr, ok )
789 nt = nt + 11
790
791
792
793 srnamt = 'CGGESX'
794 infot = 1
795 CALL cggesx(
'/',
'N',
'S',
clctsx,
'N', 1, a, 1, b, 1, sdim,
796 $ alpha, beta, q, 1, u, 1, rce, rcv, w, 1, rw, iw,
797 $ 1, bw, info )
798 CALL chkxer(
'CGGESX', infot, nout, lerr, ok )
799 infot = 2
800 CALL cggesx(
'N',
'/',
'S',
clctsx,
'N', 1, a, 1, b, 1, sdim,
801 $ alpha, beta, q, 1, u, 1, rce, rcv, w, 1, rw, iw,
802 $ 1, bw, info )
803 CALL chkxer(
'CGGESX', infot, nout, lerr, ok )
804 infot = 3
805 CALL cggesx(
'V',
'V',
'/',
clctsx,
'N', 1, a, 1, b, 1, sdim,
806 $ alpha, beta, q, 1, u, 1, rce, rcv, w, 1, rw, iw,
807 $ 1, bw, info )
808 CALL chkxer(
'CGGESX', infot, nout, lerr, ok )
809 infot = 5
810 CALL cggesx(
'V',
'V',
'S',
clctsx,
'/', 1, a, 1, b, 1, sdim,
811 $ alpha, beta, q, 1, u, 1, rce, rcv, w, 1, rw, iw,
812 $ 1, bw, info )
813 CALL chkxer(
'CGGESX', infot, nout, lerr, ok )
814 infot = 6
815 CALL cggesx(
'V',
'V',
'S',
clctsx,
'B', -1, a, 1, b, 1, sdim,
816 $ alpha, beta, q, 1, u, 1, rce, rcv, w, 1, rw, iw,
817 $ 1, bw, info )
818 CALL chkxer(
'CGGESX', infot, nout, lerr, ok )
819 infot = 8
820 CALL cggesx(
'V',
'V',
'S',
clctsx,
'B', 1, a, 0, b, 1, sdim,
821 $ alpha, beta, q, 1, u, 1, rce, rcv, w, 1, rw, iw,
822 $ 1, bw, info )
823 CALL chkxer(
'CGGESX', infot, nout, lerr, ok )
824 infot = 10
825 CALL cggesx(
'V',
'V',
'S',
clctsx,
'B', 1, a, 1, b, 0, sdim,
826 $ alpha, beta, q, 1, u, 1, rce, rcv, w, 1, rw, iw,
827 $ 1, bw, info )
828 CALL chkxer(
'CGGESX', infot, nout, lerr, ok )
829 infot = 15
830 CALL cggesx(
'V',
'V',
'S',
clctsx,
'B', 1, a, 1, b, 1, sdim,
831 $ alpha, beta, q, 0, u, 1, rce, rcv, w, 1, rw, iw,
832 $ 1, bw, info )
833 CALL chkxer(
'CGGESX', infot, nout, lerr, ok )
834 infot = 15
835 CALL cggesx(
'V',
'V',
'S',
clctsx,
'B', 2, a, 2, b, 2, sdim,
836 $ alpha, beta, q, 1, u, 1, rce, rcv, w, 1, rw, iw,
837 $ 1, bw, info )
838 CALL chkxer(
'CGGESX', infot, nout, lerr, ok )
839 infot = 17
840 CALL cggesx(
'V',
'V',
'S',
clctsx,
'B', 1, a, 1, b, 1, sdim,
841 $ alpha, beta, q, 1, u, 0, rce, rcv, w, 1, rw, iw,
842 $ 1, bw, info )
843 CALL chkxer(
'CGGESX', infot, nout, lerr, ok )
844 infot = 17
845 CALL cggesx(
'V',
'V',
'S',
clctsx,
'B', 2, a, 2, b, 2, sdim,
846 $ alpha, beta, q, 2, u, 1, rce, rcv, w, 1, rw, iw,
847 $ 1, bw, info )
848 CALL chkxer(
'CGGESX', infot, nout, lerr, ok )
849 infot = 21
850 CALL cggesx(
'V',
'V',
'S',
clctsx,
'B', 2, a, 2, b, 2, sdim,
851 $ alpha, beta, q, 2, u, 2, rce, rcv, w, 1, rw, iw,
852 $ 1, bw, info )
853 CALL chkxer(
'CGGESX', infot, nout, lerr, ok )
854 infot = 24
855 CALL cggesx(
'V',
'V',
'S',
clctsx,
'V', 1, a, 1, b, 1, sdim,
856 $ alpha, beta, q, 1, u, 1, rce, rcv, w, 32, rw, iw,
857 $ 0, bw, info )
858 CALL chkxer(
'CGGESX', infot, nout, lerr, ok )
859 nt = nt + 13
860
861
862
863 srnamt = 'CGGEV '
864 infot = 1
865 CALL cggev(
'/',
'N', 1, a, 1, b, 1, alpha, beta, q, 1, u, 1,
866 $ w, 1, rw, info )
867 CALL chkxer(
'CGGEV ', infot, nout, lerr, ok )
868 infot = 2
869 CALL cggev(
'N',
'/', 1, a, 1, b, 1, alpha, beta, q, 1, u, 1,
870 $ w, 1, rw, info )
871 CALL chkxer(
'CGGEV ', infot, nout, lerr, ok )
872 infot = 3
873 CALL cggev(
'V',
'V', -1, a, 1, b, 1, alpha, beta, q, 1, u, 1,
874 $ w, 1, rw, info )
875 CALL chkxer(
'CGGEV ', infot, nout, lerr, ok )
876 infot = 5
877 CALL cggev(
'V',
'V', 1, a, 0, b, 1, alpha, beta, q, 1, u, 1,
878 $ w, 1, rw, info )
879 CALL chkxer(
'CGGEV ', infot, nout, lerr, ok )
880 infot = 7
881 CALL cggev(
'V',
'V', 1, a, 1, b, 0, alpha, beta, q, 1, u, 1,
882 $ w, 1, rw, info )
883 CALL chkxer(
'CGGEV ', infot, nout, lerr, ok )
884 infot = 11
885 CALL cggev(
'N',
'V', 1, a, 1, b, 1, alpha, beta, q, 0, u, 1,
886 $ w, 1, rw, info )
887 CALL chkxer(
'CGGEV ', infot, nout, lerr, ok )
888 infot = 11
889 CALL cggev(
'V',
'V', 2, a, 2, b, 2, alpha, beta, q, 1, u, 2,
890 $ w, 1, rw, info )
891 CALL chkxer(
'CGGEV ', infot, nout, lerr, ok )
892 infot = 13
893 CALL cggev(
'V',
'N', 2, a, 2, b, 2, alpha, beta, q, 2, u, 0,
894 $ w, 1, rw, info )
895 CALL chkxer(
'CGGEV ', infot, nout, lerr, ok )
896 infot = 13
897 CALL cggev(
'V',
'V', 2, a, 2, b, 2, alpha, beta, q, 2, u, 1,
898 $ w, 1, rw, info )
899 CALL chkxer(
'CGGEV ', infot, nout, lerr, ok )
900 infot = 15
901 CALL cggev(
'V',
'V', 1, a, 1, b, 1, alpha, beta, q, 1, u, 1,
902 $ w, 1, rw, info )
903 CALL chkxer(
'CGGEV ', infot, nout, lerr, ok )
904 nt = nt + 10
905
906
907
908 srnamt = 'CGGEV3'
909 infot = 1
910 CALL cggev3(
'/',
'N', 1, a, 1, b, 1, alpha, beta, q, 1, u, 1,
911 $ w, 1, rw, info )
912 CALL chkxer(
'CGGEV3', infot, nout, lerr, ok )
913 infot = 2
914 CALL cggev3(
'N',
'/', 1, a, 1, b, 1, alpha, beta, q, 1, u, 1,
915 $ w, 1, rw, info )
916 CALL chkxer(
'CGGEV3', infot, nout, lerr, ok )
917 infot = 3
918 CALL cggev3(
'V',
'V', -1, a, 1, b, 1, alpha, beta, q, 1, u, 1,
919 $ w, 1, rw, info )
920 CALL chkxer(
'CGGEV3', infot, nout, lerr, ok )
921 infot = 5
922 CALL cggev3(
'V',
'V', 1, a, 0, b, 1, alpha, beta, q, 1, u, 1,
923 $ w, 1, rw, info )
924 CALL chkxer(
'CGGEV3', infot, nout, lerr, ok )
925 infot = 7
926 CALL cggev3(
'V',
'V', 1, a, 1, b, 0, alpha, beta, q, 1, u, 1,
927 $ w, 1, rw, info )
928 CALL chkxer(
'CGGEV3', infot, nout, lerr, ok )
929 infot = 11
930 CALL cggev3(
'N',
'V', 1, a, 1, b, 1, alpha, beta, q, 0, u, 1,
931 $ w, 1, rw, info )
932 CALL chkxer(
'CGGEV3', infot, nout, lerr, ok )
933 infot = 11
934 CALL cggev3(
'V',
'V', 2, a, 2, b, 2, alpha, beta, q, 1, u, 2,
935 $ w, 1, rw, info )
936 CALL chkxer(
'CGGEV3', infot, nout, lerr, ok )
937 infot = 13
938 CALL cggev3(
'V',
'N', 2, a, 2, b, 2, alpha, beta, q, 2, u, 0,
939 $ w, 1, rw, info )
940 CALL chkxer(
'CGGEV3', infot, nout, lerr, ok )
941 infot = 13
942 CALL cggev3(
'V',
'V', 2, a, 2, b, 2, alpha, beta, q, 2, u, 1,
943 $ w, 1, rw, info )
944 CALL chkxer(
'CGGEV3', infot, nout, lerr, ok )
945 infot = 15
946 CALL cggev3(
'V',
'V', 1, a, 1, b, 1, alpha, beta, q, 1, u, 1,
947 $ w, 1, rw, info )
948 CALL chkxer(
'CGGEV3', infot, nout, lerr, ok )
949 nt = nt + 10
950
951
952
953 srnamt = 'CGGEVX'
954 infot = 1
955 CALL cggevx(
'/',
'N',
'N',
'N', 1, a, 1, b, 1, alpha, beta, q,
956 $ 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
957 $ w, 1, rw, iw, bw, info )
958 CALL chkxer(
'CGGEVX', infot, nout, lerr, ok )
959 infot = 2
960 CALL cggevx(
'N',
'/',
'N',
'N', 1, a, 1, b, 1, alpha, beta, q,
961 $ 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
962 $ w, 1, rw, iw, bw, info )
963 CALL chkxer(
'CGGEVX', infot, nout, lerr, ok )
964 infot = 3
965 CALL cggevx(
'N',
'N',
'/',
'N', 1, a, 1, b, 1, alpha, beta, q,
966 $ 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
967 $ w, 1, rw, iw, bw, info )
968 CALL chkxer(
'CGGEVX', infot, nout, lerr, ok )
969 infot = 4
970 CALL cggevx(
'N',
'N',
'N',
'/', 1, a, 1, b, 1, alpha, beta, q,
971 $ 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
972 $ w, 1, rw, iw, bw, info )
973 CALL chkxer(
'CGGEVX', infot, nout, lerr, ok )
974 infot = 5
975 CALL cggevx(
'N',
'N',
'N',
'N', -1, a, 1, b, 1, alpha, beta,
976 $ q, 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce,
977 $ rcv, w, 1, rw, iw, bw, info )
978 CALL chkxer(
'CGGEVX', infot, nout, lerr, ok )
979 infot = 7
980 CALL cggevx(
'N',
'N',
'N',
'N', 1, a, 0, b, 1, alpha, beta, q,
981 $ 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
982 $ w, 1, rw, iw, bw, info )
983 CALL chkxer(
'CGGEVX', infot, nout, lerr, ok )
984 infot = 9
985 CALL cggevx(
'N',
'N',
'N',
'N', 1, a, 1, b, 0, alpha, beta, q,
986 $ 1, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
987 $ w, 1, rw, iw, bw, info )
988 CALL chkxer(
'CGGEVX', infot, nout, lerr, ok )
989 infot = 13
990 CALL cggevx(
'N',
'N',
'N',
'N', 1, a, 1, b, 1, alpha, beta, q,
991 $ 0, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
992 $ w, 1, rw, iw, bw, info )
993 CALL chkxer(
'CGGEVX', infot, nout, lerr, ok )
994 infot = 13
995 CALL cggevx(
'N',
'V',
'N',
'N', 2, a, 2, b, 2, alpha, beta, q,
996 $ 1, u, 2, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
997 $ w, 1, rw, iw, bw, info )
998 CALL chkxer(
'CGGEVX', infot, nout, lerr, ok )
999 infot = 15
1000 CALL cggevx(
'N',
'N',
'N',
'N', 1, a, 1, b, 1, alpha, beta, q,
1001 $ 1, u, 0, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
1002 $ w, 1, rw, iw, bw, info )
1003 CALL chkxer(
'CGGEVX', infot, nout, lerr, ok )
1004 infot = 15
1005 CALL cggevx(
'N',
'N',
'V',
'N', 2, a, 2, b, 2, alpha, beta, q,
1006 $ 2, u, 1, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
1007 $ w, 1, rw, iw, bw, info )
1008 CALL chkxer(
'CGGEVX', infot, nout, lerr, ok )
1009 infot = 25
1010 CALL cggevx(
'N',
'N',
'V',
'N', 2, a, 2, b, 2, alpha, beta, q,
1011 $ 2, u, 2, ilo, ihi, ls, rs, anrm, bnrm, rce, rcv,
1012 $ w, 0, rw, iw, bw, info )
1013 CALL chkxer(
'CGGEVX', infot, nout, lerr, ok )
1014 nt = nt + 12
1015
1016
1017
1018 srnamt = 'CTGEXC'
1019 infot = 3
1020 CALL ctgexc( .true., .true., -1, a, 1, b, 1, q, 1, z, 1, ifst,
1021 $ ilst, info )
1022 CALL chkxer(
'CTGEXC', infot, nout, lerr, ok )
1023 infot = 5
1024 CALL ctgexc( .true., .true., 1, a, 0, b, 1, q, 1, z, 1, ifst,
1025 $ ilst, info )
1026 CALL chkxer(
'CTGEXC', infot, nout, lerr, ok )
1027 infot = 7
1028 CALL ctgexc( .true., .true., 1, a, 1, b, 0, q, 1, z, 1, ifst,
1029 $ ilst, info )
1030 CALL chkxer(
'CTGEXC', infot, nout, lerr, ok )
1031 infot = 9
1032 CALL ctgexc( .false., .true., 1, a, 1, b, 1, q, 0, z, 1, ifst,
1033 $ ilst, info )
1034 CALL chkxer(
'CTGEXC', infot, nout, lerr, ok )
1035 infot = 9
1036 CALL ctgexc( .true., .true., 1, a, 1, b, 1, q, 0, z, 1, ifst,
1037 $ ilst, info )
1038 CALL chkxer(
'CTGEXC', infot, nout, lerr, ok )
1039 infot = 11
1040 CALL ctgexc( .true., .false., 1, a, 1, b, 1, q, 1, z, 0, ifst,
1041 $ ilst, info )
1042 CALL chkxer(
'CTGEXC', infot, nout, lerr, ok )
1043 infot = 11
1044 CALL ctgexc( .true., .true., 1, a, 1, b, 1, q, 1, z, 0, ifst,
1045 $ ilst, info )
1046 CALL chkxer(
'CTGEXC', infot, nout, lerr, ok )
1047 nt = nt + 7
1048
1049
1050
1051 srnamt = 'CTGSEN'
1052 infot = 1
1053 CALL ctgsen( -1, .true., .true., sel, 1, a, 1, b, 1, alpha,
1054 $ beta, q, 1, z, 1, m, tola, tolb, rcv, w, 1, iw, 1,
1055 $ info )
1056 CALL chkxer(
'CTGSEN', infot, nout, lerr, ok )
1057 infot = 5
1058 CALL ctgsen( 1, .true., .true., sel, -1, a, 1, b, 1, alpha,
1059 $ beta, q, 1, z, 1, m, tola, tolb, rcv, w, 1, iw, 1,
1060 $ info )
1061 CALL chkxer(
'CTGSEN', infot, nout, lerr, ok )
1062 infot = 7
1063 CALL ctgsen( 1, .true., .true., sel, 1, a, 0, b, 1, alpha,
1064 $ beta, q, 1, z, 1, m, tola, tolb, rcv, w, 1, iw, 1,
1065 $ info )
1066 CALL chkxer(
'CTGSEN', infot, nout, lerr, ok )
1067 infot = 9
1068 CALL ctgsen( 1, .true., .true., sel, 1, a, 1, b, 0, alpha,
1069 $ beta, q, 1, z, 1, m, tola, tolb, rcv, w, 1, iw, 1,
1070 $ info )
1071 CALL chkxer(
'CTGSEN', infot, nout, lerr, ok )
1072 infot = 13
1073 CALL ctgsen( 1, .true., .true., sel, 1, a, 1, b, 1, alpha,
1074 $ beta, q, 0, z, 1, m, tola, tolb, rcv, w, 1, iw, 1,
1075 $ info )
1076 CALL chkxer(
'CTGSEN', infot, nout, lerr, ok )
1077 infot = 15
1078 CALL ctgsen( 1, .true., .true., sel, 1, a, 1, b, 1, alpha,
1079 $ beta, q, 1, z, 0, m, tola, tolb, rcv, w, 1, iw, 1,
1080 $ info )
1081 CALL chkxer(
'CTGSEN', infot, nout, lerr, ok )
1082 infot = 21
1083 CALL ctgsen( 3, .true., .true., sel, 1, a, 1, b, 1, alpha,
1084 $ beta, q, 1, z, 1, m, tola, tolb, rcv, w, -5, iw,
1085 $ 1, info )
1086 CALL chkxer(
'CTGSEN', infot, nout, lerr, ok )
1087 infot = 23
1088 CALL ctgsen( 0, .true., .true., sel, 1, a, 1, b, 1, alpha,
1089 $ beta, q, 1, z, 1, m, tola, tolb, rcv, w, 20, iw,
1090 $ 0, info )
1091 CALL chkxer(
'CTGSEN', infot, nout, lerr, ok )
1092 infot = 23
1093 CALL ctgsen( 1, .true., .true., sel, 1, a, 1, b, 1, alpha,
1094 $ beta, q, 1, z, 1, m, tola, tolb, rcv, w, 20, iw,
1095 $ 0, info )
1096 CALL chkxer(
'CTGSEN', infot, nout, lerr, ok )
1097 infot = 23
1098 CALL ctgsen( 5, .true., .true., sel, 1, a, 1, b, 1, alpha,
1099 $ beta, q, 1, z, 1, m, tola, tolb, rcv, w, 20, iw,
1100 $ 1, info )
1101 CALL chkxer(
'CTGSEN', infot, nout, lerr, ok )
1102 nt = nt + 11
1103
1104
1105
1106 srnamt = 'CTGSNA'
1107 infot = 1
1108 CALL ctgsna(
'/',
'A', sel, 1, a, 1, b, 1, q, 1, u, 1, r1, r2,
1109 $ 1, m, w, 1, iw, info )
1110 CALL chkxer(
'CTGSNA', infot, nout, lerr, ok )
1111 infot = 2
1112 CALL ctgsna(
'B',
'/', sel, 1, a, 1, b, 1, q, 1, u, 1, r1, r2,
1113 $ 1, m, w, 1, iw, info )
1114 CALL chkxer(
'CTGSNA', infot, nout, lerr, ok )
1115 infot = 4
1116 CALL ctgsna(
'B',
'A', sel, -1, a, 1, b, 1, q, 1, u, 1, r1, r2,
1117 $ 1, m, w, 1, iw, info )
1118 CALL chkxer(
'CTGSNA', infot, nout, lerr, ok )
1119 infot = 6
1120 CALL ctgsna(
'B',
'A', sel, 1, a, 0, b, 1, q, 1, u, 1, r1, r2,
1121 $ 1, m, w, 1, iw, info )
1122 CALL chkxer(
'CTGSNA', infot, nout, lerr, ok )
1123 infot = 8
1124 CALL ctgsna(
'B',
'A', sel, 1, a, 1, b, 0, q, 1, u, 1, r1, r2,
1125 $ 1, m, w, 1, iw, info )
1126 CALL chkxer(
'CTGSNA', infot, nout, lerr, ok )
1127 infot = 10
1128 CALL ctgsna(
'E',
'A', sel, 1, a, 1, b, 1, q, 0, u, 1, r1, r2,
1129 $ 1, m, w, 1, iw, info )
1130 CALL chkxer(
'CTGSNA', infot, nout, lerr, ok )
1131 infot = 12
1132 CALL ctgsna(
'E',
'A', sel, 1, a, 1, b, 1, q, 1, u, 0, r1, r2,
1133 $ 1, m, w, 1, iw, info )
1134 CALL chkxer(
'CTGSNA', infot, nout, lerr, ok )
1135 infot = 15
1136 CALL ctgsna(
'E',
'A', sel, 1, a, 1, b, 1, q, 1, u, 1, r1, r2,
1137 $ 0, m, w, 1, iw, info )
1138 CALL chkxer(
'CTGSNA', infot, nout, lerr, ok )
1139 infot = 18
1140 CALL ctgsna(
'E',
'A', sel, 1, a, 1, b, 1, q, 1, u, 1, r1, r2,
1141 $ 1, m, w, 0, iw, info )
1142 CALL chkxer(
'CTGSNA', infot, nout, lerr, ok )
1143 nt = nt + 9
1144
1145
1146
1147 srnamt = 'CTGSYL'
1148 infot = 1
1149 CALL ctgsyl(
'/', 0, 1, 1, a, 1, b, 1, q, 1, u, 1, v, 1, z, 1,
1150 $ scale, dif, w, 1, iw, info )
1151 CALL chkxer(
'CTGSYL', infot, nout, lerr, ok )
1152 infot = 2
1153 CALL ctgsyl(
'N', -1, 1, 1, a, 1, b, 1, q, 1, u, 1, v, 1, z, 1,
1154 $ scale, dif, w, 1, iw, info )
1155 CALL chkxer(
'CTGSYL', infot, nout, lerr, ok )
1156 infot = 3
1157 CALL ctgsyl(
'N', 0, 0, 1, a, 1, b, 1, q, 1, u, 1, v, 1, z, 1,
1158 $ scale, dif, w, 1, iw, info )
1159 CALL chkxer(
'CTGSYL', infot, nout, lerr, ok )
1160 infot = 4
1161 CALL ctgsyl(
'N', 0, 1, 0, a, 1, b, 1, q, 1, u, 1, v, 1, z, 1,
1162 $ scale, dif, w, 1, iw, info )
1163 CALL chkxer(
'CTGSYL', infot, nout, lerr, ok )
1164 infot = 6
1165 CALL ctgsyl(
'N', 0, 1, 1, a, 0, b, 1, q, 1, u, 1, v, 1, z, 1,
1166 $ scale, dif, w, 1, iw, info )
1167 CALL chkxer(
'CTGSYL', infot, nout, lerr, ok )
1168 infot = 8
1169 CALL ctgsyl(
'N', 0, 1, 1, a, 1, b, 0, q, 1, u, 1, v, 1, z, 1,
1170 $ scale, dif, w, 1, iw, info )
1171 CALL chkxer(
'CTGSYL', infot, nout, lerr, ok )
1172 infot = 10
1173 CALL ctgsyl(
'N', 0, 1, 1, a, 1, b, 1, q, 0, u, 1, v, 1, z, 1,
1174 $ scale, dif, w, 1, iw, info )
1175 CALL chkxer(
'CTGSYL', infot, nout, lerr, ok )
1176 infot = 12
1177 CALL ctgsyl(
'N', 0, 1, 1, a, 1, b, 1, q, 1, u, 0, v, 1, z, 1,
1178 $ scale, dif, w, 1, iw, info )
1179 CALL chkxer(
'CTGSYL', infot, nout, lerr, ok )
1180 infot = 14
1181 CALL ctgsyl(
'N', 0, 1, 1, a, 1, b, 1, q, 1, u, 1, v, 0, z, 1,
1182 $ scale, dif, w, 1, iw, info )
1183 CALL chkxer(
'CTGSYL', infot, nout, lerr, ok )
1184 infot = 16
1185 CALL ctgsyl(
'N', 0, 1, 1, a, 1, b, 1, q, 1, u, 1, v, 1, z, 0,
1186 $ scale, dif, w, 1, iw, info )
1187 CALL chkxer(
'CTGSYL', infot, nout, lerr, ok )
1188 infot = 20
1189 CALL ctgsyl(
'N', 1, 1, 1, a, 1, b, 1, q, 1, u, 1, v, 1, z, 1,
1190 $ scale, dif, w, 1, iw, info )
1191 CALL chkxer(
'CTGSYL', infot, nout, lerr, ok )
1192 infot = 20
1193 CALL ctgsyl(
'N', 2, 1, 1, a, 1, b, 1, q, 1, u, 1, v, 1, z, 1,
1194 $ scale, dif, w, 1, iw, info )
1195 CALL chkxer(
'CTGSYL', infot, nout, lerr, ok )
1196 nt = nt + 12
1197 END IF
1198
1199
1200
1201 IF( ok ) THEN
1202 WRITE( nout, fmt = 9999 )path, nt
1203 ELSE
1204 WRITE( nout, fmt = 9998 )path
1205 END IF
1206
1207 9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits (',
1208 $ i3, ' tests done)' )
1209 9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
1210 $ 'exits ***' )
1211
1212 RETURN
1213
1214
1215
subroutine xlaenv(ispec, nvalue)
XLAENV
subroutine chkxer(srnamt, infot, nout, lerr, ok)
logical function clctes(z, d)
CLCTES
logical function clctsx(alpha, beta)
CLCTSX
subroutine cgges3(jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, rwork, bwork, info)
CGGES3 computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
subroutine cgges(jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, rwork, bwork, info)
CGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE m...
subroutine cggesx(jobvsl, jobvsr, sort, selctg, sense, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv, work, lwork, rwork, iwork, liwork, bwork, info)
CGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
subroutine cggev3(jobvl, jobvr, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, work, lwork, rwork, info)
CGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (...
subroutine cggev(jobvl, jobvr, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, work, lwork, rwork, info)
CGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
subroutine cggevx(balanc, jobvl, jobvr, sense, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde, rcondv, work, lwork, rwork, iwork, bwork, info)
CGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
subroutine cggglm(n, m, p, a, lda, b, ldb, d, x, y, work, lwork, info)
CGGGLM
subroutine cgghd3(compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, work, lwork, info)
CGGHD3
subroutine cgghrd(compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, info)
CGGHRD
subroutine cgglse(m, n, p, a, lda, b, ldb, c, d, x, work, lwork, info)
CGGLSE solves overdetermined or underdetermined systems for OTHER matrices
subroutine cggqrf(n, m, p, a, lda, taua, b, ldb, taub, work, lwork, info)
CGGQRF
subroutine cggrqf(m, p, n, a, lda, taua, b, ldb, taub, work, lwork, info)
CGGRQF
subroutine cggsvd3(jobu, jobv, jobq, m, n, p, k, l, a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work, lwork, rwork, iwork, info)
CGGSVD3 computes the singular value decomposition (SVD) for OTHER matrices
subroutine cggsvp3(jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork, tau, work, lwork, info)
CGGSVP3
subroutine chgeqz(job, compq, compz, n, ilo, ihi, h, ldh, t, ldt, alpha, beta, q, ldq, z, ldz, work, lwork, rwork, info)
CHGEQZ
logical function lsamen(n, ca, cb)
LSAMEN
subroutine ctgevc(side, howmny, select, n, s, lds, p, ldp, vl, ldvl, vr, ldvr, mm, m, work, rwork, info)
CTGEVC
subroutine ctgexc(wantq, wantz, n, a, lda, b, ldb, q, ldq, z, ldz, ifst, ilst, info)
CTGEXC
subroutine ctgsen(ijob, wantq, wantz, select, n, a, lda, b, ldb, alpha, beta, q, ldq, z, ldz, m, pl, pr, dif, work, lwork, iwork, liwork, info)
CTGSEN
subroutine ctgsja(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)
CTGSJA
subroutine ctgsna(job, howmny, select, n, a, lda, b, ldb, vl, ldvl, vr, ldvr, s, dif, mm, m, work, lwork, iwork, info)
CTGSNA
subroutine ctgsyl(trans, ijob, m, n, a, lda, b, ldb, c, ldc, d, ldd, e, lde, f, ldf, scale, dif, work, lwork, iwork, info)
CTGSYL
recursive subroutine cuncsd(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, rwork, lrwork, iwork, info)
CUNCSD