OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
derred.f
Go to the documentation of this file.
1*> \brief \b DERRED
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE DERRED( PATH, NUNIT )
12*
13* .. Scalar Arguments ..
14* CHARACTER*3 PATH
15* INTEGER NUNIT
16* ..
17*
18*
19*> \par Purpose:
20* =============
21*>
22*> \verbatim
23*>
24*> DERRED tests the error exits for the eigenvalue driver routines for
25*> DOUBLE PRECISION matrices:
26*>
27*> PATH driver description
28*> ---- ------ -----------
29*> SEV DGEEV find eigenvalues/eigenvectors for nonsymmetric A
30*> SES DGEES find eigenvalues/Schur form for nonsymmetric A
31*> SVX DGEEVX SGEEV + balancing and condition estimation
32*> SSX DGEESX SGEES + balancing and condition estimation
33*> DBD DGESVD compute SVD of an M-by-N matrix A
34*> DGESDD compute SVD of an M-by-N matrix A (by divide and
35*> conquer)
36*> DGEJSV compute SVD of an M-by-N matrix A where M >= N
37*> DGESVDX compute SVD of an M-by-N matrix A(by bisection
38*> and inverse iteration)
39*> DGESVDQ compute SVD of an M-by-N matrix A(with a
40*> QR-Preconditioned )
41*> \endverbatim
42*
43* Arguments:
44* ==========
45*
46*> \param[in] PATH
47*> \verbatim
48*> PATH is CHARACTER*3
49*> The LAPACK path name for the routines to be tested.
50*> \endverbatim
51*>
52*> \param[in] NUNIT
53*> \verbatim
54*> NUNIT is INTEGER
55*> The unit number for output.
56*> \endverbatim
57*
58* Authors:
59* ========
60*
61*> \author Univ. of Tennessee
62*> \author Univ. of California Berkeley
63*> \author Univ. of Colorado Denver
64*> \author NAG Ltd.
65*
66*> \ingroup double_eig
67*
68* =====================================================================
69 SUBROUTINE derred( PATH, NUNIT )
70*
71* -- LAPACK test routine --
72* -- LAPACK is a software package provided by Univ. of Tennessee, --
73* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
74*
75* .. Scalar Arguments ..
76 CHARACTER*3 PATH
77 INTEGER NUNIT
78* ..
79*
80* =====================================================================
81*
82* .. Parameters ..
83 INTEGER NMAX
84 DOUBLE PRECISION ONE, ZERO
85 parameter( nmax = 4, one = 1.0d0, zero = 0.0d0 )
86* ..
87* .. Local Scalars ..
88 CHARACTER*2 C2
89 INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
90 DOUBLE PRECISION ABNRM
91* ..
92* .. Local Arrays ..
93 LOGICAL B( NMAX )
94 INTEGER IW( 2*NMAX )
95 DOUBLE PRECISION A( NMAX, NMAX ), R1( NMAX ), R2( NMAX ),
96 $ S( NMAX ), U( NMAX, NMAX ), VL( NMAX, NMAX ),
97 $ VR( NMAX, NMAX ), VT( NMAX, NMAX ),
98 $ W( 10*NMAX ), WI( NMAX ), WR( NMAX )
99* ..
100* .. External Subroutines ..
101 EXTERNAL chkxer, dgees, dgeesx, dgeev, dgeevx, dgejsv,
102 $ dgesdd, dgesvd, dgesvdx, dgesvq
103* ..
104* .. External Functions ..
105 LOGICAL DSLECT, LSAMEN
106 EXTERNAL dslect, lsamen
107* ..
108* .. Intrinsic Functions ..
109 INTRINSIC len_trim
110* ..
111* .. Arrays in Common ..
112 LOGICAL SELVAL( 20 )
113 DOUBLE PRECISION SELWI( 20 ), SELWR( 20 )
114* ..
115* .. Scalars in Common ..
116 LOGICAL LERR, OK
117 CHARACTER*32 SRNAMT
118 INTEGER INFOT, NOUT, SELDIM, SELOPT
119* ..
120* .. Common blocks ..
121 COMMON / infoc / infot, nout, ok, lerr
122 COMMON / srnamc / srnamt
123 COMMON / sslct / selopt, seldim, selval, selwr, selwi
124* ..
125* .. Executable Statements ..
126*
127 nout = nunit
128 WRITE( nout, fmt = * )
129 c2 = path( 2: 3 )
130*
131* Initialize A
132*
133 DO 20 j = 1, nmax
134 DO 10 i = 1, nmax
135 a( i, j ) = zero
136 10 CONTINUE
137 20 CONTINUE
138 DO 30 i = 1, nmax
139 a( i, i ) = one
140 30 CONTINUE
141 ok = .true.
142 nt = 0
143*
144 IF( lsamen( 2, c2, 'EV' ) ) THEN
145*
146* Test DGEEV
147*
148 srnamt = 'DGEEV '
149 infot = 1
150 CALL dgeev( 'X', 'n', 0, A, 1, WR, WI, VL, 1, VR, 1, W, 1,
151 $ INFO )
152 CALL CHKXER( 'dgeev ', INFOT, NOUT, LERR, OK )
153 INFOT = 2
154 CALL DGEEV( 'n', 'x', 0, A, 1, WR, WI, VL, 1, VR, 1, W, 1,
155 $ INFO )
156 CALL CHKXER( 'dgeev ', INFOT, NOUT, LERR, OK )
157 INFOT = 3
158 CALL DGEEV( 'n', 'N', -1, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
159 $ info )
160 CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
161 infot = 5
162 CALL dgeev( 'N', 'N', 2, a, 1, wr, wi, vl, 1, vr, 1, w, 6,
163 $ info )
164 CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
165 infot = 9
166 CALL dgeev( 'V', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
167 $ info )
168 CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
169 infot = 11
170 CALL dgeev( 'N', 'V', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
171 $ info )
172 CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
173 infot = 13
174 CALL dgeev( 'V', 'V', 1, a, 1, wr, wi, vl, 1, vr, 1, w, 3,
175 $ info )
176 CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
177 nt = nt + 7
178*
179 ELSE IF( lsamen( 2, c2, 'ES' ) ) THEN
180*
181* Test DGEES
182*
183 srnamt = 'DGEES '
184 infot = 1
185 CALL dgees( 'X', 'N', dslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
186 $ 1, b, info )
187 CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
188 infot = 2
189 CALL dgees( 'N', 'X', dslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
190 $ 1, b, info )
191 CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
192 infot = 4
193 CALL dgees( 'N', 'S', dslect, -1, a, 1, sdim, wr, wi, vl, 1, w,
194 $ 1, b, info )
195 CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
196 infot = 6
197 CALL dgees( 'n', 's', DSLECT, 2, A, 1, SDIM, WR, WI, VL, 1, W,
198 $ 6, B, INFO )
199 CALL CHKXER( 'dgees ', INFOT, NOUT, LERR, OK )
200 INFOT = 11
201 CALL DGEES( 'v', 's', DSLECT, 2, A, 2, SDIM, WR, WI, VL, 1, W,
202 $ 6, B, INFO )
203 CALL CHKXER( 'dgees ', INFOT, NOUT, LERR, OK )
204 INFOT = 13
205 CALL DGEES( 'n', 's', DSLECT, 1, A, 1, SDIM, WR, WI, VL, 1, W,
206 $ 2, B, INFO )
207 CALL CHKXER( 'dgees ', INFOT, NOUT, LERR, OK )
208 NT = NT + 6
209*
210 ELSE IF( LSAMEN( 2, C2, 'vx' ) ) THEN
211*
212* Test DGEEVX
213*
214 SRNAMT = 'dgeevx'
215 INFOT = 1
216 CALL DGEEVX( 'x', 'n', 'n', 'n', 0, A, 1, WR, WI, VL, 1, VR, 1,
217 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
218 CALL CHKXER( 'dgeevx', INFOT, NOUT, LERR, OK )
219 INFOT = 2
220 CALL DGEEVX( 'n', 'x', 'n', 'n', 0, A, 1, WR, WI, VL, 1, VR, 1,
221 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
222 CALL CHKXER( 'dgeevx', INFOT, NOUT, LERR, OK )
223 INFOT = 3
224 CALL DGEEVX( 'n', 'n', 'x', 'n', 0, A, 1, WR, WI, VL, 1, VR, 1,
225 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
226 CALL CHKXER( 'dgeevx', INFOT, NOUT, LERR, OK )
227 INFOT = 4
228 CALL DGEEVX( 'n', 'n', 'n', 'x', 0, A, 1, WR, WI, VL, 1, VR, 1,
229 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
230 CALL CHKXER( 'dgeevx', INFOT, NOUT, LERR, OK )
231 INFOT = 5
232 CALL DGEEVX( 'n', 'n', 'n', 'n', -1, A, 1, WR, WI, VL, 1, VR,
233 $ 1, ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
234 CALL CHKXER( 'dgeevx', INFOT, NOUT, LERR, OK )
235 INFOT = 7
236 CALL DGEEVX( 'n', 'n', 'n', 'n', 2, A, 1, WR, WI, VL, 1, VR, 1,
237 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
238 CALL CHKXER( 'dgeevx', INFOT, NOUT, LERR, OK )
239 INFOT = 11
240 CALL DGEEVX( 'n', 'v', 'n', 'n', 2, A, 2, WR, WI, VL, 1, VR, 1,
241 $ ILO, IHI, S, ABNRM, R1, R2, W, 6, IW, INFO )
242 CALL CHKXER( 'dgeevx', INFOT, NOUT, LERR, OK )
243 INFOT = 13
244 CALL DGEEVX( 'n', 'n', 'v', 'n', 2, A, 2, WR, WI, VL, 1, VR, 1,
245 $ ILO, IHI, S, ABNRM, R1, R2, W, 6, IW, INFO )
246 CALL CHKXER( 'dgeevx', INFOT, NOUT, LERR, OK )
247 INFOT = 21
248 CALL DGEEVX( 'n', 'n', 'n', 'n', 1, A, 1, WR, WI, VL, 1, VR, 1,
249 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
250 CALL CHKXER( 'dgeevx', INFOT, NOUT, LERR, OK )
251 INFOT = 21
252 CALL DGEEVX( 'n', 'v', 'n', 'n', 1, A, 1, WR, WI, VL, 1, VR, 1,
253 $ ILO, IHI, S, ABNRM, R1, R2, W, 2, IW, INFO )
254 CALL CHKXER( 'dgeevx', INFOT, NOUT, LERR, OK )
255 INFOT = 21
256 CALL DGEEVX( 'n', 'n', 'v', 'v', 1, A, 1, WR, WI, VL, 1, VR, 1,
257 $ ILO, IHI, S, ABNRM, R1, R2, W, 3, IW, INFO )
258 CALL CHKXER( 'dgeevx', INFOT, NOUT, LERR, OK )
259 NT = NT + 11
260*
261 ELSE IF( LSAMEN( 2, C2, 'sx' ) ) THEN
262*
263* Test DGEESX
264*
265 SRNAMT = 'dgeesx'
266 INFOT = 1
267 CALL DGEESX( 'x', 'n', DSLECT, 'n', 0, A, 1, SDIM, WR, WI, VL,
268 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
269 CALL CHKXER( 'dgeesx', INFOT, NOUT, LERR, OK )
270 INFOT = 2
271 CALL DGEESX( 'n', 'x', DSLECT, 'n', 0, A, 1, SDIM, WR, WI, VL,
272 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
273 CALL CHKXER( 'dgeesx', INFOT, NOUT, LERR, OK )
274 INFOT = 4
275 CALL DGEESX( 'n', 'n', DSLECT, 'x', 0, A, 1, SDIM, WR, WI, VL,
276 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
277 CALL CHKXER( 'dgeesx', INFOT, NOUT, LERR, OK )
278 INFOT = 5
279 CALL DGEESX( 'n', 'n', DSLECT, 'n', -1, A, 1, SDIM, WR, WI, VL,
280 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
281 CALL CHKXER( 'dgeesx', INFOT, NOUT, LERR, OK )
282 INFOT = 7
283 CALL DGEESX( 'n', 'n', DSLECT, 'n', 2, A, 1, SDIM, WR, WI, VL,
284 $ 1, R1( 1 ), R2( 1 ), W, 6, IW, 1, B, INFO )
285 CALL CHKXER( 'dgeesx', INFOT, NOUT, LERR, OK )
286 INFOT = 12
287 CALL DGEESX( 'v', 'n', DSLECT, 'n', 2, A, 2, SDIM, WR, WI, VL,
288 $ 1, R1( 1 ), R2( 1 ), W, 6, IW, 1, B, INFO )
289 CALL CHKXER( 'dgeesx', INFOT, NOUT, LERR, OK )
290 INFOT = 16
291 CALL DGEESX( 'n', 'n', DSLECT, 'n', 1, A, 1, SDIM, WR, WI, VL,
292 $ 1, R1( 1 ), R2( 1 ), W, 2, IW, 1, B, INFO )
293 CALL CHKXER( 'dgeesx', INFOT, NOUT, LERR, OK )
294 NT = NT + 7
295*
296 ELSE IF( LSAMEN( 2, C2, 'bd' ) ) THEN
297*
298* Test DGESVD
299*
300 SRNAMT = 'dgesvd'
301 INFOT = 1
302 CALL DGESVD( 'x', 'n', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO )
303 CALL CHKXER( 'dgesvd', INFOT, NOUT, LERR, OK )
304 INFOT = 2
305 CALL DGESVD( 'n', 'x', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO )
306 CALL CHKXER( 'dgesvd', INFOT, NOUT, LERR, OK )
307 INFOT = 2
308 CALL DGESVD( 'o', 'o', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO )
309 CALL CHKXER( 'dgesvd', INFOT, NOUT, LERR, OK )
310 INFOT = 3
311 CALL DGESVD( 'n', 'n', -1, 0, A, 1, S, U, 1, VT, 1, W, 1,
312 $ INFO )
313 CALL CHKXER( 'dgesvd', INFOT, NOUT, LERR, OK )
314 INFOT = 4
315 CALL DGESVD( 'n', 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1,
316 $ info )
317 CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
318 infot = 6
319 CALL dgesvd( 'N', 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, info )
320 CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
321 infot = 9
322 CALL dgesvd( 'A', 'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, info )
323 CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
324 infot = 11
325 CALL dgesvd( 'N', 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, info )
326 CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
327 nt = 8
328 IF( ok ) THEN
329 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
330 $ nt
331 ELSE
332 WRITE( nout, fmt = 9998 )
333 END IF
334*
335* Test DGESDD
336*
337 srnamt = 'DGESDD'
338 infot = 1
339 CALL dgesdd( 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
340 CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
341 infot = 2
342 CALL dgesdd( 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
343 CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
344 infot = 3
345 CALL dgesdd( 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
346 CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
347 infot = 5
348 CALL dgesdd( 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
349 CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
350 infot = 8
351 CALL dgesdd( 'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, iw, info )
352 CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
353 infot = 10
354 CALL dgesdd( 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
355 CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
356 nt = 6
357 IF( ok ) THEN
358 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
359 $ nt
360 ELSE
361 WRITE( nout, fmt = 9998 )
362 END IF
363*
364* Test DGEJSV
365*
366 srnamt = 'DGEJSV'
367 infot = 1
368 CALL dgejsv( 'X', 'U', 'V', 'R', 'N', 'N',
369 $ 0, 0, a, 1, s, u, 1, vt, 1,
370 $ w, 1, iw, info)
371 CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
372 infot = 2
373 CALL dgejsv( 'G', 'X', 'V', 'R', 'N', 'N',
374 $ 0, 0, a, 1, s, u, 1, vt, 1,
375 $ w, 1, iw, info)
376 CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
377 infot = 3
378 CALL dgejsv( 'G', 'U', 'X', 'R', 'N', 'N',
379 $ 0, 0, a, 1, s, u, 1, vt, 1,
380 $ w, 1, iw, info)
381 CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
382 infot = 4
383 CALL dgejsv( 'G', 'U', 'V', 'X', 'N', 'N',
384 $ 0, 0, a, 1, s, u, 1, vt, 1,
385 $ w, 1, iw, info)
386 CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
387 infot = 5
388 CALL dgejsv( 'G', 'U', 'V', 'R', 'X', 'N',
389 $ 0, 0, a, 1, s, u, 1, vt, 1,
390 $ w, 1, iw, info)
391 CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
392 infot = 6
393 CALL dgejsv( 'G', 'U', 'v', 'r', 'n', 'x',
394 $ 0, 0, A, 1, S, U, 1, VT, 1,
395 $ W, 1, IW, INFO)
396 CALL CHKXER( 'dgejsv', INFOT, NOUT, LERR, OK )
397 INFOT = 7
398 CALL DGEJSV( 'g', 'u', 'v', 'r', 'n', 'n',
399 $ -1, 0, A, 1, S, U, 1, VT, 1,
400 $ W, 1, IW, INFO)
401 CALL CHKXER( 'dgejsv', infot, nout, lerr, ok )
402 infot = 8
403 CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
404 $ 0, -1, a, 1, s, u, 1, vt, 1,
405 $ w, 1, iw, info)
406 CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
407 infot = 10
408 CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
409 $ 2, 1, a, 1, s, u, 1, vt, 1,
410 $ w, 1, iw, info)
411 CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
412 infot = 13
413 CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
414 $ 2, 2, a, 2, s, u, 1, vt, 2,
415 $ w, 1, iw, info)
416 CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
417 infot = 15
418 CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
419 $ 2, 2, a, 2, s, u, 2, vt, 1,
420 $ w, 1, iw, info)
421 CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
422 nt = 11
423 IF( ok ) THEN
424 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
425 $ nt
426 ELSE
427 WRITE( nout, fmt = 9998 )
428 END IF
429*
430* Test DGESVDX
431*
432 srnamt = 'DGESVDX'
433 infot = 1
434 CALL dgesvdx( 'X', 'N', 'A', 0, 0, a, 1, zero, zero,
435 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
436 CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
437 infot = 2
438 CALL dgesvdx( 'N', 'X', 'A', 0, 0, a, 1, zero, zero,
439 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
440 CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
441 infot = 3
442 CALL dgesvdx( 'N', 'N', 'X', 0, 0, a, 1, zero, zero,
443 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
444 CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
445 infot = 4
446 CALL dgesvdx( 'N', 'N', 'A', -1, 0, a, 1, zero, zero,
447 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
448 CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
449 infot = 5
450 CALL dgesvdx( 'N', 'N', 'A', 0, -1, a, 1, zero, zero,
451 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
452 CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
453 infot = 7
454 CALL dgesvdx( 'N', 'N', 'A', 2, 1, a, 1, zero, zero,
455 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
456 CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
457 infot = 8
458 CALL dgesvdx( 'N', 'N', 'V', 2, 1, a, 2, -one, zero,
459 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
460 CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
461 infot = 9
462 CALL dgesvdx( 'N', 'N', 'V', 2, 1, a, 2, one, zero,
463 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
464 CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
465 infot = 10
466 CALL dgesvdx( 'N', 'N', 'I', 2, 2, a, 2, zero, zero,
467 $ 0, 1, ns, s, u, 1, vt, 1, w, 1, iw, info )
468 CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
469 infot = 11
470 CALL dgesvdx( 'V', 'N', 'I', 2, 2, a, 2, zero, zero,
471 $ 1, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
472 CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
473 infot = 15
474 CALL dgesvdx( 'V', 'N', 'A', 2, 2, a, 2, zero, zero,
475 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
476 CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
477 infot = 17
478 CALL dgesvdx( 'N', 'V', 'A', 2, 2, a, 2, zero, zero,
479 $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
480 CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
481 nt = 12
482 IF( ok ) THEN
483 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
484 $ nt
485 ELSE
486 WRITE( nout, fmt = 9998 )
487 END IF
488*
489* Test DGESVDQ
490*
491 srnamt = 'DGESVDQ'
492 infot = 1
493 CALL dgesvdq( 'X', 'P', 'T', 'A', 'A', 0, 0, a, 1, s, u,
494 $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
495 CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
496 infot = 2
497 CALL dgesvdq( 'A', 'X', 'T', 'A', 'A', 0, 0, a, 1, s, u,
498 $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
499 CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
500 infot = 3
501 CALL dgesvdq( 'A', 'P', 'X', 'A', 'A', 0, 0, a, 1, s, u,
502 $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
503 CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
504 infot = 4
505 CALL dgesvdq( 'A', 'P', 'T', 'X', 'A', 0, 0, a, 1, s, u,
506 $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
507 CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
508 infot = 5
509 CALL dgesvdq( 'A', 'P', 'T', 'A', 'X', 0, 0, a, 1, s, u,
510 $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
511 CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
512 infot = 6
513 CALL dgesvdq( 'A', 'P', 'T', 'A', 'A', -1, 0, a, 1, s, u,
514 $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
515 CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
516 infot = 7
517 CALL dgesvdq( 'A', 'P', 'T', 'A', 'A', 0, 1, a, 1, s, u,
518 $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
519 CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
520 infot = 9
521 CALL dgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 0, s, u,
522 $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
523 CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
524 infot = 12
525 CALL dgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
526 $ -1, vt, 0, ns, iw, 1, w, 1, w, 1, info )
527 CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
528 infot = 14
529 CALL dgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
530 $ 1, vt, -1, ns, iw, 1, w, 1, w, 1, info )
531 CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
532 infot = 17
533 CALL dgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
534 $ 1, vt, 1, ns, iw, -5, w, 1, w, 1, info )
535 CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
536 nt = 11
537 IF( ok ) THEN
538 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
539 $ nt
540 ELSE
541 WRITE( nout, fmt = 9998 )
542 END IF
543 END IF
544*
545* Print a summary line.
546*
547 IF( .NOT.lsamen( 2, c2, 'BD' ) ) THEN
548 IF( ok ) THEN
549 WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
550 $ nt
551 ELSE
552 WRITE( nout, fmt = 9998 )
553 END IF
554 END IF
555*
556 9999 FORMAT( 1x, a, ' passed the tests of the error exits (', i3,
557 $ ' tests done)' )
558 9998 FORMAT( ' *** ', a, ' failed the tests of the error exits ***' )
559 RETURN
560*
561* End of DERRED
562 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
dgeevx
subroutine dgeevx(balanc, jobvl, jobvr, sense, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, work, lwork, iwork, info)
DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
Definition dgeevx.f:306
dgeesx
subroutine dgeesx(jobvs, sort, select, sense, n, a, lda, sdim, wr, wi, vs, ldvs, rconde, rcondv, work, lwork, iwork, liwork, bwork, info)
DGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
Definition dgeesx.f:281
dgeev
subroutine dgeev(jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, work, lwork, info)
DGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
Definition dgeev.f:192
dgees
subroutine dgees(jobvs, sort, select, n, a, lda, sdim, wr, wi, vs, ldvs, work, lwork, bwork, info)
DGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE m...
Definition dgees.f:216
dgesvdx
subroutine dgesvdx(jobu, jobvt, range, m, n, a, lda, vl, vu, il, iu, ns, s, u, ldu, vt, ldvt, work, lwork, iwork, info)
DGESVDX computes the singular value decomposition (SVD) for GE matrices
Definition dgesvdx.f:263
dgesdd
subroutine dgesdd(jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, iwork, info)
DGESDD
Definition dgesdd.f:219
dgesvd
subroutine dgesvd(jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, info)
DGESVD computes the singular value decomposition (SVD) for GE matrices
Definition dgesvd.f:211
dgejsv
subroutine dgejsv(joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, work, lwork, iwork, info)
DGEJSV
Definition dgejsv.f:476
dgesvdq
subroutine dgesvdq(joba, jobp, jobr, jobu, jobv, m, n, a, lda, s, u, ldu, v, ldv, numrank, iwork, liwork, work, lwork, rwork, lrwork, info)
DGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE...
Definition dgesvdq.f:415
derred
subroutine derred(path, nunit)
DERRED
Definition derred.f:70