70
71
72
73
74
75
76 CHARACTER*3 PATH
77 INTEGER NUNIT
78
79
80
81
82
83 INTEGER NMAX, LW
84 parameter( nmax = 4, lw = 5*nmax )
85 DOUBLE PRECISION ONE, ZERO
86 parameter( one = 1.0d0, zero = 0.0d0 )
87
88
89 CHARACTER*2 C2
90 INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
91 DOUBLE PRECISION ABNRM
92
93
94 LOGICAL B( NMAX )
95 INTEGER IW( 4*NMAX )
96 DOUBLE PRECISION R1( NMAX ), R2( NMAX ), RW( LW ), S( NMAX )
97 COMPLEX*16 A( NMAX, NMAX ), U( NMAX, NMAX ),
98 $ VL( NMAX, NMAX ), VR( NMAX, NMAX ),
99 $ VT( NMAX, NMAX ), W( 10*NMAX ), X( NMAX )
100
101
104
105
106 LOGICAL LSAMEN, ZSLECT
108
109
110 INTRINSIC len_trim
111
112
113 LOGICAL SELVAL( 20 )
114 DOUBLE PRECISION SELWI( 20 ), SELWR( 20 )
115
116
117 LOGICAL LERR, OK
118 CHARACTER*32 SRNAMT
119 INTEGER INFOT, NOUT, SELDIM, SELOPT
120
121
122 COMMON / infoc / infot, nout, ok, lerr
123 COMMON / srnamc / srnamt
124 COMMON / sslct / selopt, seldim, selval, selwr, selwi
125
126
127
128 nout = nunit
129 WRITE( nout, fmt = * )
130 c2 = path( 2: 3 )
131
132
133
134 DO 20 j = 1, nmax
135 DO 10 i = 1, nmax
136 a( i, j ) = zero
137 10 CONTINUE
138 20 CONTINUE
139 DO 30 i = 1, nmax
140 a( i, i ) = one
141 30 CONTINUE
142 ok = .true.
143 nt = 0
144
145 IF(
lsamen( 2, c2,
'EV' ) )
THEN
146
147
148
149 srnamt = 'ZGEEV '
150 infot = 1
151 CALL zgeev(
'X',
'N', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
152 $ info )
153 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
154 infot = 2
155 CALL zgeev(
'N',
'X', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
156 $ info )
157 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
158 infot = 3
159 CALL zgeev(
'N',
'N', -1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
160 $ info )
161 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
162 infot = 5
163 CALL zgeev(
'N',
'N', 2, a, 1, x, vl, 1, vr, 1, w, 4, rw,
164 $ info )
165 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
166 infot = 8
167 CALL zgeev(
'V',
'N', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
168 $ info )
169 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
170 infot = 10
171 CALL zgeev(
'N',
'V', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
172 $ info )
173 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
174 infot = 12
175 CALL zgeev(
'V',
'V', 1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
176 $ info )
177 CALL chkxer(
'ZGEEV ', infot, nout, lerr, ok )
178 nt = nt + 7
179
180 ELSE IF(
lsamen( 2, c2,
'ES' ) )
THEN
181
182
183
184 srnamt = 'ZGEES '
185 infot = 1
186 CALL zgees(
'X',
'N',
zslect, 0, a, 1, sdim, x, vl, 1, w, 1,
187 $ rw, b, info )
188 CALL chkxer(
'ZGEES ', infot, nout, lerr, ok )
189 infot = 2
190 CALL zgees(
'N',
'X',
zslect, 0, a, 1, sdim, x, vl, 1, w, 1,
191 $ rw, b, info )
192 CALL chkxer(
'ZGEES ', infot, nout, lerr, ok )
193 infot = 4
194 CALL zgees(
'N',
'S',
zslect, -1, a, 1, sdim, x, vl, 1, w, 1,
195 $ rw, b, info )
196 CALL chkxer(
'ZGEES ', infot, nout, lerr, ok )
197 infot = 6
198 CALL zgees(
'N',
'S',
zslect, 2, a, 1, sdim, x, vl, 1, w, 4,
199 $ rw, b, info )
200 CALL chkxer(
'ZGEES ', infot, nout, lerr, ok )
201 infot = 10
202 CALL zgees(
'V',
'S',
zslect, 2, a, 2, sdim, x, vl, 1, w, 4,
203 $ rw, b, info )
204 CALL chkxer(
'ZGEES ', infot, nout, lerr, ok )
205 infot = 12
206 CALL zgees(
'N',
'S',
zslect, 1, a, 1, sdim, x, vl, 1, w, 1,
207 $ rw, b, info )
208 CALL chkxer(
'ZGEES ', infot, nout, lerr, ok )
209 nt = nt + 6
210
211 ELSE IF(
lsamen( 2, c2,
'VX' ) )
THEN
212
213
214
215 srnamt = 'ZGEEVX'
216 infot = 1
217 CALL zgeevx(
'X',
'N',
'N',
'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
218 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
219 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
220 infot = 2
221 CALL zgeevx(
'N',
'X',
'N',
'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
222 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
223 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
224 infot = 3
225 CALL zgeevx(
'N',
'N',
'X',
'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
226 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
227 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
228 infot = 4
229 CALL zgeevx(
'N',
'N',
'N',
'X', 0, a, 1, x, vl, 1, vr, 1, ilo,
230 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
231 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
232 infot = 5
233 CALL zgeevx(
'N',
'N',
'N',
'N', -1, a, 1, x, vl, 1, vr, 1,
234 $ ilo, ihi, s, abnrm, r1, r2, w, 1, rw, info )
235 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
236 infot = 7
237 CALL zgeevx(
'N',
'N',
'N',
'N', 2, a, 1, x, vl, 1, vr, 1, ilo,
238 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
239 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
240 infot = 10
241 CALL zgeevx(
'N',
'V',
'N',
'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
242 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
243 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
244 infot = 12
245 CALL zgeevx(
'N',
'N',
'V',
'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
246 $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
247 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
248 infot = 20
249 CALL zgeevx(
'N',
'N',
'N',
'N', 1, a, 1, x, vl, 1, vr, 1, ilo,
250 $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
251 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
252 infot = 20
253 CALL zgeevx(
'N',
'N',
'V',
'V', 1, a, 1, x, vl, 1, vr, 1, ilo,
254 $ ihi, s, abnrm, r1, r2, w, 2, rw, info )
255 CALL chkxer(
'ZGEEVX', infot, nout, lerr, ok )
256 nt = nt + 10
257
258 ELSE IF(
lsamen( 2, c2,
'SX' ) )
THEN
259
260
261
262 srnamt = 'ZGEESX'
263 infot = 1
264 CALL zgeesx(
'X',
'N',
zslect,
'N', 0, a, 1, sdim, x, vl, 1,
265 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
266 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
267 infot = 2
268 CALL zgeesx(
'N',
'X',
zslect,
'N', 0, a, 1, sdim, x, vl, 1,
269 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
270 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
271 infot = 4
272 CALL zgeesx(
'N',
'N',
zslect,
'X', 0, a, 1, sdim, x, vl, 1,
273 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
274 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
275 infot = 5
276 CALL zgeesx(
'N',
'N',
zslect,
'N', -1, a, 1, sdim, x, vl, 1,
277 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
278 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
279 infot = 7
280 CALL zgeesx(
'N',
'N',
zslect,
'N', 2, a, 1, sdim, x, vl, 1,
281 $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
282 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
283 infot = 11
284 CALL zgeesx(
'V',
'N',
zslect,
'N', 2, a, 2, sdim, x, vl, 1,
285 $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
286 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
287 infot = 15
288 CALL zgeesx(
'N',
'N',
zslect,
'N', 1, a, 1, sdim, x, vl, 1,
289 $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
290 CALL chkxer(
'ZGEESX', infot, nout, lerr, ok )
291 nt = nt + 7
292
293 ELSE IF(
lsamen( 2, c2,
'BD' ) )
THEN
294
295
296
297 srnamt = 'ZGESVD'
298 infot = 1
299 CALL zgesvd(
'X',
'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
300 $ info )
301 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
302 infot = 2
303 CALL zgesvd(
'N',
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
304 $ info )
305 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
306 infot = 2
307 CALL zgesvd(
'O',
'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
308 $ info )
309 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
310 infot = 3
311 CALL zgesvd(
'N',
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
312 $ info )
313 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
314 infot = 4
315 CALL zgesvd(
'N',
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw,
316 $ info )
317 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
318 infot = 6
319 CALL zgesvd(
'N',
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw,
320 $ info )
321 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
322 infot = 9
323 CALL zgesvd(
'A',
'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw,
324 $ info )
325 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
326 infot = 11
327 CALL zgesvd(
'N',
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw,
328 $ info )
329 CALL chkxer(
'ZGESVD', infot, nout, lerr, ok )
330 nt = nt + 8
331 IF( ok ) THEN
332 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
333 $ nt
334 ELSE
335 WRITE( nout, fmt = 9998 )
336 END IF
337
338
339
340 srnamt = 'ZGESDD'
341 infot = 1
342 CALL zgesdd(
'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
343 $ info )
344 CALL chkxer(
'ZGESDD', infot, nout, lerr, ok )
345 infot = 2
346 CALL zgesdd(
'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
347 $ info )
348 CALL chkxer(
'ZGESDD', infot, nout, lerr, ok )
349 infot = 3
350 CALL zgesdd(
'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
351 $ info )
352 CALL chkxer(
'ZGESDD', infot, nout, lerr, ok )
353 infot = 5
354 CALL zgesdd(
'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
355 $ info )
356 CALL chkxer(
'ZGESDD', infot, nout, lerr, ok )
357 infot = 8
358 CALL zgesdd(
'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw, iw,
359 $ info )
360 CALL chkxer(
'ZGESDD', infot, nout, lerr, ok )
361 infot = 10
362 CALL zgesdd(
'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
363 $ info )
364 CALL chkxer(
'ZGESDD', infot, nout, lerr, ok )
365 nt = nt - 2
366 IF( ok ) THEN
367 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
368 $ nt
369 ELSE
370 WRITE( nout, fmt = 9998 )
371 END IF
372
373
374
375 srnamt = 'ZGEJSV'
376 infot = 1
377 CALL zgejsv(
'X',
'U',
'V',
'R',
'N',
'N',
378 $ 0, 0, a, 1, s, u, 1, vt, 1,
379 $ w, 1, rw, 1, iw, info)
380 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
381 infot = 2
382 CALL zgejsv(
'G',
'X',
'V',
'R',
'N',
'N',
383 $ 0, 0, a, 1, s, u, 1, vt, 1,
384 $ w, 1, rw, 1, iw, info)
385 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
386 infot = 3
387 CALL zgejsv(
'G',
'U',
'X',
'R',
'N',
'N',
388 $ 0, 0, a, 1, s, u, 1, vt, 1,
389 $ w, 1, rw, 1, iw, info)
390 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
391 infot = 4
392 CALL zgejsv(
'G',
'U',
'V',
'X',
'N',
'N',
393 $ 0, 0, a, 1, s, u, 1, vt, 1,
394 $ w, 1, rw, 1, iw, info)
395 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
396 infot = 5
397 CALL zgejsv(
'G',
'U',
'V',
'R',
'X',
'N',
398 $ 0, 0, a, 1, s, u, 1, vt, 1,
399 $ w, 1, rw, 1, iw, info)
400 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
401 infot = 6
402 CALL zgejsv(
'G',
'U',
'V',
'R',
'N',
'X',
403 $ 0, 0, a, 1, s, u, 1, vt, 1,
404 $ w, 1, rw, 1, iw, info)
405 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
406 infot = 7
407 CALL zgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
408 $ -1, 0, a, 1, s, u, 1, vt, 1,
409 $ w, 1, rw, 1, iw, info)
410 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
411 infot = 8
412 CALL zgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
413 $ 0, -1, a, 1, s, u, 1, vt, 1,
414 $ w, 1, rw, 1, iw, info)
415 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
416 infot = 10
417 CALL zgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
418 $ 2, 1, a, 1, s, u, 1, vt, 1,
419 $ w, 1, rw, 1, iw, info)
420 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
421 infot = 13
422 CALL zgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
423 $ 2, 2, a, 2, s, u, 1, vt, 2,
424 $ w, 1, rw, 1, iw, info)
425 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
426 infot = 15
427 CALL zgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
428 $ 2, 2, a, 2, s, u, 2, vt, 1,
429 $ w, 1, rw, 1, iw, info)
430 CALL chkxer(
'ZGEJSV', infot, nout, lerr, ok )
431 nt = 11
432 IF( ok ) THEN
433 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
434 $ nt
435 ELSE
436 WRITE( nout, fmt = 9998 )
437 END IF
438
439
440
441 srnamt = 'ZGESVDX'
442 infot = 1
443 CALL zgesvdx(
'X',
'N',
'A', 0, 0, a, 1, zero, zero,
444 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
445 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
446 infot = 2
447 CALL zgesvdx(
'N',
'X',
'A', 0, 0, a, 1, zero, zero,
448 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
449 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
450 infot = 3
451 CALL zgesvdx(
'N',
'N',
'X', 0, 0, a, 1, zero, zero,
452 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
453 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
454 infot = 4
455 CALL zgesvdx(
'N',
'N',
'A', -1, 0, a, 1, zero, zero,
456 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
457 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
458 infot = 5
459 CALL zgesvdx(
'N',
'N',
'A', 0, -1, a, 1, zero, zero,
460 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
461 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
462 infot = 7
463 CALL zgesvdx(
'N',
'N',
'A', 2, 1, a, 1, zero, zero,
464 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
465 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
466 infot = 8
467 CALL zgesvdx(
'N',
'N',
'V', 2, 1, a, 2, -one, zero,
468 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
469 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
470 infot = 9
471 CALL zgesvdx(
'N',
'N',
'V', 2, 1, a, 2, one, zero,
472 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
473 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
474 infot = 10
475 CALL zgesvdx(
'N',
'N',
'I', 2, 2, a, 2, zero, zero,
476 $ 0, 1, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
477 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
478 infot = 11
479 CALL zgesvdx(
'V',
'N',
'I', 2, 2, a, 2, zero, zero,
480 $ 1, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
481 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
482 infot = 15
483 CALL zgesvdx(
'V',
'N',
'A', 2, 2, a, 2, zero, zero,
484 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
485 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
486 infot = 17
487 CALL zgesvdx(
'N',
'V',
'A', 2, 2, a, 2, zero, zero,
488 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
489 CALL chkxer(
'ZGESVDX', infot, nout, lerr, ok )
490 nt = 12
491 IF( ok ) THEN
492 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
493 $ nt
494 ELSE
495 WRITE( nout, fmt = 9998 )
496 END IF
497
498
499
500 srnamt = 'ZGESVDQ'
501 infot = 1
502 CALL zgesvdq(
'X',
'P',
'T',
'A',
'A', 0, 0, a, 1, s, u,
503 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
504 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
505 infot = 2
506 CALL zgesvdq(
'A',
'X',
'T',
'A',
'A', 0, 0, a, 1, s, u,
507 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
508 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
509 infot = 3
510 CALL zgesvdq(
'A',
'P',
'X',
'A',
'A', 0, 0, a, 1, s, u,
511 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
512 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
513 infot = 4
514 CALL zgesvdq(
'A',
'P',
'T',
'X',
'A', 0, 0, a, 1, s, u,
515 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
516 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
517 infot = 5
518 CALL zgesvdq(
'A',
'P',
'T',
'A',
'X', 0, 0, a, 1, s, u,
519 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
520 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
521 infot = 6
522 CALL zgesvdq(
'A',
'P',
'T',
'A',
'A', -1, 0, a, 1, s, u,
523 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
524 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
525 infot = 7
526 CALL zgesvdq(
'A',
'P',
'T',
'A',
'A', 0, 1, a, 1, s, u,
527 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
528 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
529 infot = 9
530 CALL zgesvdq(
'A',
'P',
'T',
'A',
'A', 1, 1, a, 0, s, u,
531 $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
532 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
533 infot = 12
534 CALL zgesvdq(
'A',
'P',
'T',
'A',
'A', 1, 1, a, 1, s, u,
535 $ -1, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
536 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
537 infot = 14
538 CALL zgesvdq(
'A',
'P',
'T',
'A',
'A', 1, 1, a, 1, s, u,
539 $ 1, vt, -1, ns, iw, 1, w, 1, rw, 1, info )
540 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
541 infot = 17
542 CALL zgesvdq(
'A',
'P',
'T',
'A',
'A', 1, 1, a, 1, s, u,
543 $ 1, vt, 1, ns, iw, -5, w, 1, rw, 1, info )
544 CALL chkxer(
'ZGESVDQ', infot, nout, lerr, ok )
545 nt = 11
546 IF( ok ) THEN
547 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
548 $ nt
549 ELSE
550 WRITE( nout, fmt = 9998 )
551 END IF
552 END IF
553
554
555
556 IF( .NOT.
lsamen( 2, c2,
'BD' ) )
THEN
557 IF( ok ) THEN
558 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
559 $ nt
560 ELSE
561 WRITE( nout, fmt = 9998 )
562 END IF
563 END IF
564
565 9999 FORMAT( 1x, a, ' passed the tests of the error exits (', i3,
566 $ ' tests done)' )
567 9998 FORMAT( ' *** ', a, ' failed the tests of the error exits ***' )
568 RETURN
569
570
571
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine zgees(jobvs, sort, select, n, a, lda, sdim, w, vs, ldvs, work, lwork, rwork, bwork, info)
ZGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE m...
subroutine zgeesx(jobvs, sort, select, sense, n, a, lda, sdim, w, vs, ldvs, rconde, rcondv, work, lwork, rwork, bwork, info)
ZGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
subroutine zgeev(jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr, work, lwork, rwork, info)
ZGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
subroutine zgeevx(balanc, jobvl, jobvr, sense, n, a, lda, w, vl, ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, work, lwork, rwork, info)
ZGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
subroutine zgejsv(joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, cwork, lwork, rwork, lrwork, iwork, info)
ZGEJSV
subroutine zgesdd(jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, rwork, iwork, info)
ZGESDD
subroutine zgesvd(jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, rwork, info)
ZGESVD computes the singular value decomposition (SVD) for GE matrices
subroutine zgesvdq(joba, jobp, jobr, jobu, jobv, m, n, a, lda, s, u, ldu, v, ldv, numrank, iwork, liwork, cwork, lcwork, rwork, lrwork, info)
ZGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE...
subroutine zgesvdx(jobu, jobvt, range, m, n, a, lda, vl, vu, il, iu, ns, s, u, ldu, vt, ldvt, work, lwork, rwork, iwork, info)
ZGESVDX computes the singular value decomposition (SVD) for GE matrices
subroutine zgesvj(joba, jobu, jobv, m, n, a, lda, sva, mv, v, ldv, cwork, lwork, rwork, lrwork, info)
ZGESVJ
logical function lsamen(n, ca, cb)
LSAMEN
logical function zslect(z)
ZSLECT