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