OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
serred.f
Go to the documentation of this file.
1*> \brief \b SERRED
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 SERRED( 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*> SERRED tests the error exits for the eigenvalue driver routines for
25*> REAL matrices:
26*>
27*> PATH driver description
28*> ---- ------ -----------
29*> SEV SGEEV find eigenvalues/eigenvectors for nonsymmetric A
30*> SES SGEES find eigenvalues/Schur form for nonsymmetric A
31*> SVX SGEEVX SGEEV + balancing and condition estimation
32*> SSX SGEESX SGEES + balancing and condition estimation
33*> SBD SGESVD compute SVD of an M-by-N matrix A
34*> SGESDD compute SVD of an M-by-N matrix A (by divide and
35*> conquer)
36*> SGEJSV compute SVD of an M-by-N matrix A where M >= N
37*> SGESVDX compute SVD of an M-by-N matrix A(by bisection
38*> and inverse iteration)
39*> SGESVDQ 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 single_eig
67*
68* =====================================================================
69 SUBROUTINE serred( 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 REAL ONE, ZERO
85 parameter( nmax = 4, one = 1.0e0, zero = 0.0e0 )
86* ..
87* .. Local Scalars ..
88 CHARACTER*2 C2
89 INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
90 REAL ABNRM
91* ..
92* .. Local Arrays ..
93 LOGICAL B( NMAX )
94 INTEGER IW( 2*NMAX )
95 REAL 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, sgees, sgeesx, sgeev, sgeevx, sgejsv,
102 $ sgesdd, sgesvd, sgesvdx, sgesvdq
103* ..
104* .. External Functions ..
105 LOGICAL SSLECT, LSAMEN
106 EXTERNAL sslect, lsamen
107* ..
108* .. Intrinsic Functions ..
109 INTRINSIC len_trim
110* ..
111* .. Arrays in Common ..
112 LOGICAL SELVAL( 20 )
113 REAL 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 SGEEV
147*
148 srnamt = 'SGEEV '
149 infot = 1
150 CALL sgeev( 'X', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
151 $ info )
152 CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
153 infot = 2
154 CALL sgeev( 'N', 'X', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
155 $ info )
156 CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
157 infot = 3
158 CALL sgeev( 'N', 'N', -1, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
159 $ info )
160 CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
161 infot = 5
162 CALL sgeev( 'N', 'N', 2, a, 1, wr, wi, vl, 1, vr, 1, w, 6,
163 $ info )
164 CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
165 infot = 9
166 CALL sgeev( 'V', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
167 $ info )
168 CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
169 infot = 11
170 CALL sgeev( 'N', 'V', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
171 $ info )
172 CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
173 infot = 13
174 CALL sgeev( 'V', 'V', 1, a, 1, wr, wi, vl, 1, vr, 1, w, 3,
175 $ info )
176 CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
177 nt = nt + 7
178*
179 ELSE IF( lsamen( 2, c2, 'ES' ) ) THEN
180*
181* Test SGEES
182*
183 srnamt = 'SGEES '
184 infot = 1
185 CALL sgees( 'X', 'N', sslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
186 $ 1, b, info )
187 CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
188 infot = 2
189 CALL sgees( 'N', 'X', sslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
190 $ 1, b, info )
191 CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
192 infot = 4
193 CALL sgees( 'N', 'S', sslect, -1, a, 1, sdim, wr, wi, vl, 1, w,
194 $ 1, b, info )
195 CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
196 infot = 6
197 CALL sgees( 'N', 'S', sslect, 2, a, 1, sdim, wr, wi, vl, 1, w,
198 $ 6, b, info )
199 CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
200 infot = 11
201 CALL sgees( 'V', 'S', sslect, 2, a, 2, sdim, wr, wi, vl, 1, w,
202 $ 6, b, info )
203 CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
204 infot = 13
205 CALL sgees( 'N', 'S', sslect, 1, a, 1, sdim, wr, wi, vl, 1, w,
206 $ 2, b, info )
207 CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
208 nt = nt + 6
209*
210 ELSE IF( lsamen( 2, c2, 'VX' ) ) THEN
211*
212* Test SGEEVX
213*
214 srnamt = 'SGEEVX'
215 infot = 1
216 CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
219 infot = 2
220 CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
223 infot = 3
224 CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
227 infot = 4
228 CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
231 infot = 5
232 CALL sgeevx( '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( 'sgeevx', INFOT, NOUT, LERR, OK )
235 INFOT = 7
236 CALL SGEEVX( '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( 'sgeevx', INFOT, NOUT, LERR, OK )
239 INFOT = 11
240 CALL SGEEVX( '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( 'sgeevx', INFOT, NOUT, LERR, OK )
243 INFOT = 13
244 CALL SGEEVX( '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( 'sgeevx', INFOT, NOUT, LERR, OK )
247 INFOT = 21
248 CALL SGEEVX( '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( 'SGEEVX', infot, nout, lerr, ok )
251 infot = 21
252 CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
255 infot = 21
256 CALL sgeevx( '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( 'SGEEVX', infot, nout, lerr, ok )
259 nt = nt + 11
260*
261 ELSE IF( lsamen( 2, c2, 'SX' ) ) THEN
262*
263* Test SGEESX
264*
265 srnamt = 'SGEESX'
266 infot = 1
267 CALL sgeesx( 'X', 'N', sslect, 'N', 0, a, 1, sdim, wr, wi, vl,
268 $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
269 CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
270 infot = 2
271 CALL sgeesx( 'N', 'X', sslect, 'N', 0, a, 1, sdim, wr, wi, vl,
272 $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
273 CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
274 infot = 4
275 CALL sgeesx( 'n', 'n', SSLECT, 'x', 0, A, 1, SDIM, WR, WI, VL,
276 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
277 CALL CHKXER( 'sgeesx', INFOT, NOUT, LERR, OK )
278 INFOT = 5
279 CALL SGEESX( 'n', 'n', SSLECT, 'n', -1, A, 1, SDIM, WR, WI, VL,
280 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
281 CALL CHKXER( 'sgeesx', INFOT, NOUT, LERR, OK )
282 INFOT = 7
283 CALL SGEESX( 'n', 'n', SSLECT, 'n', 2, A, 1, SDIM, WR, WI, VL,
284 $ 1, R1( 1 ), R2( 1 ), W, 6, IW, 1, B, INFO )
285 CALL CHKXER( 'sgeesx', INFOT, NOUT, LERR, OK )
286 INFOT = 12
287 CALL SGEESX( 'v', 'n', SSLECT, 'n', 2, A, 2, SDIM, WR, WI, VL,
288 $ 1, R1( 1 ), R2( 1 ), W, 6, IW, 1, B, INFO )
289 CALL CHKXER( 'sgeesx', INFOT, NOUT, LERR, OK )
290 INFOT = 16
291 CALL SGEESX( 'n', 'n', SSLECT, 'n', 1, A, 1, SDIM, WR, WI, VL,
292 $ 1, R1( 1 ), R2( 1 ), W, 2, IW, 1, B, INFO )
293 CALL CHKXER( 'sgeesx', INFOT, NOUT, LERR, OK )
294 NT = NT + 7
295*
296 ELSE IF( LSAMEN( 2, C2, 'bd' ) ) THEN
297*
298* Test SGESVD
299*
300 SRNAMT = 'sgesvd'
301 INFOT = 1
302 CALL SGESVD( 'x', 'n', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO )
303 CALL CHKXER( 'sgesvd', INFOT, NOUT, LERR, OK )
304 INFOT = 2
305 CALL SGESVD( 'n', 'x', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO )
306 CALL CHKXER( 'sgesvd', INFOT, NOUT, LERR, OK )
307 INFOT = 2
308 CALL SGESVD( 'o', 'o', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO )
309 CALL CHKXER( 'sgesvd', INFOT, NOUT, LERR, OK )
310 INFOT = 3
311 CALL SGESVD( 'n', 'n', -1, 0, A, 1, S, U, 1, VT, 1, W, 1,
312 $ INFO )
313 CALL CHKXER( 'sgesvd', INFOT, NOUT, LERR, OK )
314 INFOT = 4
315 CALL SGESVD( 'n', 'n', 0, -1, A, 1, S, U, 1, VT, 1, W, 1,
316 $ INFO )
317 CALL CHKXER( 'sgesvd', INFOT, NOUT, LERR, OK )
318 INFOT = 6
319 CALL SGESVD( 'n', 'n', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, INFO )
320 CALL CHKXER( 'sgesvd', INFOT, NOUT, LERR, OK )
321 INFOT = 9
322 CALL SGESVD( 'a', 'n', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, INFO )
323 CALL CHKXER( 'sgesvd', INFOT, NOUT, LERR, OK )
324 INFOT = 11
325 CALL SGESVD( 'n', 'a', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, INFO )
326 CALL CHKXER( 'sgesvd', 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 SGESDD
336*
337 SRNAMT = 'sgesdd'
338 INFOT = 1
339 CALL SGESDD( 'x', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO )
340 CALL CHKXER( 'sgesdd', INFOT, NOUT, LERR, OK )
341 INFOT = 2
342 CALL SGESDD( 'n', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO )
343 CALL CHKXER( 'sgesdd', INFOT, NOUT, LERR, OK )
344 INFOT = 3
345 CALL SGESDD( 'n', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO )
346 CALL CHKXER( 'sgesdd', INFOT, NOUT, LERR, OK )
347 INFOT = 5
348 CALL SGESDD( 'n', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, IW, INFO )
349 CALL CHKXER( 'sgesdd', INFOT, NOUT, LERR, OK )
350 INFOT = 8
351 CALL SGESDD( 'a', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, IW, INFO )
352 CALL CHKXER( 'sgesdd', INFOT, NOUT, LERR, OK )
353 INFOT = 10
354 CALL SGESDD( 'a', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, IW, INFO )
355 CALL CHKXER( 'sgesdd', 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 SGEJSV
365*
366 SRNAMT = 'sgejsv'
367 INFOT = 1
368 CALL SGEJSV( 'x', 'u', 'v', 'r', 'n', 'n',
369 $ 0, 0, A, 1, S, U, 1, VT, 1,
370 $ W, 1, IW, INFO)
371 CALL CHKXER( 'sgejsv', INFOT, NOUT, LERR, OK )
372 INFOT = 2
373 CALL SGEJSV( 'g', 'x', 'v', 'r', 'n', 'N',
374 $ 0, 0, a, 1, s, u, 1, vt, 1,
375 $ w, 1, iw, info)
376 CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
377 infot = 3
378 CALL sgejsv( 'G', 'U', 'X', 'R', 'N', 'N',
379 $ 0, 0, a, 1, s, u, 1, vt, 1,
380 $ w, 1, iw, info)
381 CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
382 infot = 4
383 CALL sgejsv( 'G', 'U', 'V', 'X', 'N', 'N',
384 $ 0, 0, a, 1, s, u, 1, vt, 1,
385 $ w, 1, iw, info)
386 CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
387 infot = 5
388 CALL sgejsv( 'G', 'U', 'V', 'R', 'X', 'N',
389 $ 0, 0, a, 1, s, u, 1, vt, 1,
390 $ w, 1, iw, info)
391 CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
392 infot = 6
393 CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'X',
394 $ 0, 0, a, 1, s, u, 1, vt, 1,
395 $ w, 1, iw, info)
396 CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
397 infot = 7
398 CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
399 $ -1, 0, a, 1, s, u, 1, vt, 1,
400 $ w, 1, iw, info)
401 CALL chkxer( 'sgejsv', INFOT, NOUT, LERR, OK )
402 INFOT = 8
403 CALL SGEJSV( 'g', 'u', 'v', 'r', 'n', 'n',
404 $ 0, -1, A, 1, S, U, 1, VT, 1,
405 $ W, 1, IW, INFO)
406 CALL CHKXER( 'sgejsv', INFOT, NOUT, LERR, OK )
407 INFOT = 10
408 CALL SGEJSV( 'g', 'u', 'v', 'r', 'N', 'N',
409 $ 2, 1, a, 1, s, u, 1, vt, 1,
410 $ w, 1, iw, info)
411 CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
412 infot = 13
413 CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
414 $ 2, 2, a, 2, s, u, 1, vt, 2,
415 $ w, 1, iw, info)
416 CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
417 infot = 15
418 CALL sgejsv( 'G', 'U', 'V', 'R', 'n', 'n',
419 $ 2, 2, A, 2, S, U, 2, VT, 1,
420 $ W, 1, IW, INFO)
421 CALL CHKXER( 'sgejsv', 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 SGESVDX
431*
432 SRNAMT = 'sgesvdx'
433 INFOT = 1
434 CALL SGESVDX( '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( 'sgesvdx', INFOT, NOUT, LERR, OK )
437 INFOT = 2
438 CALL SGESVDX( '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( 'sgesvdx', INFOT, NOUT, LERR, OK )
441 INFOT = 3
442 CALL SGESVDX( '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( 'sgesvdx', INFOT, NOUT, LERR, OK )
445 INFOT = 4
446 CALL SGESVDX( '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( 'sgesvdx', INFOT, NOUT, LERR, OK )
449 INFOT = 5
450 CALL SGESVDX( '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( 'sgesvdx', INFOT, NOUT, LERR, OK )
453 INFOT = 7
454 CALL SGESVDX( '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( 'sgesvdx', INFOT, NOUT, LERR, OK )
457 INFOT = 8
458 CALL SGESVDX( '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( 'SGESVDX', infot, nout, lerr, ok )
461 infot = 9
462 CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
465 infot = 10
466 CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
469 infot = 11
470 CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
473 infot = 15
474 CALL sgesvdx( '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( 'SGESVDX', infot, nout, lerr, ok )
477 infot = 17
478 CALL sgesvdx( '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( 'SGESVDX', 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 SGESVDQ
490*
491 srnamt = 'SGESVDQ'
492 infot = 1
493 CALL sgesvdq( '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( 'SGESVDQ', infot, nout, lerr, ok )
496 infot = 2
497 CALL sgesvdq( '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( 'SGESVDQ', infot, nout, lerr, ok )
500 infot = 3
501 CALL sgesvdq( '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( 'sgesvdq', INFOT, NOUT, LERR, OK )
504 INFOT = 4
505 CALL SGESVDQ( '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( 'sgesvdq', INFOT, NOUT, LERR, OK )
508 INFOT = 5
509 CALL SGESVDQ( '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( 'sgesvdq', INFOT, NOUT, LERR, OK )
512 INFOT = 6
513 CALL SGESVDQ( '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( 'sgesvdq', INFOT, NOUT, LERR, OK )
516 INFOT = 7
517 CALL SGESVDQ( '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( 'sgesvdq', INFOT, NOUT, LERR, OK )
520 INFOT = 9
521 CALL SGESVDQ( '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( 'sgesvdq', INFOT, NOUT, LERR, OK )
524 INFOT = 12
525 CALL SGESVDQ( '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( 'sgesvdq', INFOT, NOUT, LERR, OK )
528 INFOT = 14
529 CALL SGESVDQ( '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( 'sgesvdq', infot, nout, lerr, ok )
532 infot = 17
533 CALL sgesvdq( '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( 'SGESVDQ', 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 SERRED
562*
563 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
sgeev
subroutine sgeev(jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, work, lwork, info)
SGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
Definition sgeev.f:192
sgeesx
subroutine sgeesx(jobvs, sort, select, sense, n, a, lda, sdim, wr, wi, vs, ldvs, rconde, rcondv, work, lwork, iwork, liwork, bwork, info)
SGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
Definition sgeesx.f:281
sgeevx
subroutine sgeevx(balanc, jobvl, jobvr, sense, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, work, lwork, iwork, info)
SGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
Definition sgeevx.f:306
sgees
subroutine sgees(jobvs, sort, select, n, a, lda, sdim, wr, wi, vs, ldvs, work, lwork, bwork, info)
SGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE m...
Definition sgees.f:216
sgesvd
subroutine sgesvd(jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, info)
SGESVD computes the singular value decomposition (SVD) for GE matrices
Definition sgesvd.f:211
sgesvdq
subroutine sgesvdq(joba, jobp, jobr, jobu, jobv, m, n, a, lda, s, u, ldu, v, ldv, numrank, iwork, liwork, work, lwork, rwork, lrwork, info)
SGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE...
Definition sgesvdq.f:415
sgesvdx
subroutine sgesvdx(jobu, jobvt, range, m, n, a, lda, vl, vu, il, iu, ns, s, u, ldu, vt, ldvt, work, lwork, iwork, info)
SGESVDX computes the singular value decomposition (SVD) for GE matrices
Definition sgesvdx.f:263
sgesdd
subroutine sgesdd(jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, iwork, info)
SGESDD
Definition sgesdd.f:219
sgejsv
subroutine sgejsv(joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, work, lwork, iwork, info)
SGEJSV
Definition sgejsv.f:476
serred
subroutine serred(path, nunit)
SERRED
Definition serred.f:70