LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
serred.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine serred (PATH, NUNIT)
 SERRED More...
 

Function/Subroutine Documentation

subroutine serred ( character*3  PATH,
integer  NUNIT 
)

SERRED

Purpose:
 SERRED tests the error exits for the eigenvalue driver routines for
 REAL matrices:

 PATH  driver   description
 ----  ------   -----------
 SEV   SGEEV    find eigenvalues/eigenvectors for nonsymmetric A
 SES   SGEES    find eigenvalues/Schur form for nonsymmetric A
 SVX   SGEEVX   SGEEV + balancing and condition estimation
 SSX   SGEESX   SGEES + balancing and condition estimation
 SBD   SGESVD   compute SVD of an M-by-N matrix A
       SGESDD   compute SVD of an M-by-N matrix A (by divide and
                conquer)
       SGEJSV   compute SVD of an M-by-N matrix A where M >= N
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 68 of file serred.f.

68 *
69 * -- LAPACK test routine (version 3.4.0) --
70 * -- LAPACK is a software package provided by Univ. of Tennessee, --
71 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
72 * November 2011
73 *
74 * .. Scalar Arguments ..
75  CHARACTER*3 path
76  INTEGER nunit
77 * ..
78 *
79 * =====================================================================
80 *
81 * .. Parameters ..
82  INTEGER nmax
83  REAL one, zero
84  parameter( nmax = 4, one = 1.0e0, zero = 0.0e0 )
85 * ..
86 * .. Local Scalars ..
87  CHARACTER*2 c2
88  INTEGER i, ihi, ilo, info, j, nt, sdim
89  REAL abnrm
90 * ..
91 * .. Local Arrays ..
92  LOGICAL b( nmax )
93  INTEGER iw( 2*nmax )
94  REAL a( nmax, nmax ), r1( nmax ), r2( nmax ),
95  $ s( nmax ), u( nmax, nmax ), vl( nmax, nmax ),
96  $ vr( nmax, nmax ), vt( nmax, nmax ),
97  $ w( 4*nmax ), wi( nmax ), wr( nmax )
98 * ..
99 * .. External Subroutines ..
100  EXTERNAL chkxer, sgees, sgeesx, sgeev, sgeevx, sgejsv,
101  $ sgesdd, sgesvd
102 * ..
103 * .. External Functions ..
104  LOGICAL lsamen, sslect
105  EXTERNAL lsamen, sslect
106 * ..
107 * .. Intrinsic Functions ..
108  INTRINSIC len_trim
109 * ..
110 * .. Arrays in Common ..
111  LOGICAL selval( 20 )
112  REAL selwi( 20 ), selwr( 20 )
113 * ..
114 * .. Scalars in Common ..
115  LOGICAL lerr, ok
116  CHARACTER*32 srnamt
117  INTEGER infot, nout, seldim, selopt
118 * ..
119 * .. Common blocks ..
120  COMMON / infoc / infot, nout, ok, lerr
121  COMMON / srnamc / srnamt
122  COMMON / sslct / selopt, seldim, selval, selwr, selwi
123 * ..
124 * .. Executable Statements ..
125 *
126  nout = nunit
127  WRITE( nout, fmt = * )
128  c2 = path( 2: 3 )
129 *
130 * Initialize A
131 *
132  DO 20 j = 1, nmax
133  DO 10 i = 1, nmax
134  a( i, j ) = zero
135  10 CONTINUE
136  20 CONTINUE
137  DO 30 i = 1, nmax
138  a( i, i ) = one
139  30 CONTINUE
140  ok = .true.
141  nt = 0
142 *
143  IF( lsamen( 2, c2, 'EV' ) ) THEN
144 *
145 * Test SGEEV
146 *
147  srnamt = 'SGEEV '
148  infot = 1
149  CALL sgeev( 'X', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
150  $ info )
151  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
152  infot = 2
153  CALL sgeev( 'N', 'X', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
154  $ info )
155  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
156  infot = 3
157  CALL sgeev( 'N', 'N', -1, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
158  $ info )
159  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
160  infot = 5
161  CALL sgeev( 'N', 'N', 2, a, 1, wr, wi, vl, 1, vr, 1, w, 6,
162  $ info )
163  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
164  infot = 9
165  CALL sgeev( 'V', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
166  $ info )
167  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
168  infot = 11
169  CALL sgeev( 'N', 'V', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
170  $ info )
171  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
172  infot = 13
173  CALL sgeev( 'V', 'V', 1, a, 1, wr, wi, vl, 1, vr, 1, w, 3,
174  $ info )
175  CALL chkxer( 'SGEEV ', infot, nout, lerr, ok )
176  nt = nt + 7
177 *
178  ELSE IF( lsamen( 2, c2, 'ES' ) ) THEN
179 *
180 * Test SGEES
181 *
182  srnamt = 'SGEES '
183  infot = 1
184  CALL sgees( 'X', 'N', sslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
185  $ 1, b, info )
186  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
187  infot = 2
188  CALL sgees( 'N', 'X', sslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
189  $ 1, b, info )
190  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
191  infot = 4
192  CALL sgees( 'N', 'S', sslect, -1, a, 1, sdim, wr, wi, vl, 1, w,
193  $ 1, b, info )
194  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
195  infot = 6
196  CALL sgees( 'N', 'S', sslect, 2, a, 1, sdim, wr, wi, vl, 1, w,
197  $ 6, b, info )
198  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
199  infot = 11
200  CALL sgees( 'V', 'S', sslect, 2, a, 2, sdim, wr, wi, vl, 1, w,
201  $ 6, b, info )
202  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
203  infot = 13
204  CALL sgees( 'N', 'S', sslect, 1, a, 1, sdim, wr, wi, vl, 1, w,
205  $ 2, b, info )
206  CALL chkxer( 'SGEES ', infot, nout, lerr, ok )
207  nt = nt + 6
208 *
209  ELSE IF( lsamen( 2, c2, 'VX' ) ) THEN
210 *
211 * Test SGEEVX
212 *
213  srnamt = 'SGEEVX'
214  infot = 1
215  CALL sgeevx( 'X', 'N', 'N', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
216  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
217  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
218  infot = 2
219  CALL sgeevx( 'N', 'X', 'N', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
220  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
221  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
222  infot = 3
223  CALL sgeevx( 'N', 'N', 'X', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
224  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
225  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
226  infot = 4
227  CALL sgeevx( 'N', 'N', 'N', 'X', 0, a, 1, wr, wi, vl, 1, vr, 1,
228  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
229  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
230  infot = 5
231  CALL sgeevx( 'N', 'N', 'N', 'N', -1, a, 1, wr, wi, vl, 1, vr,
232  $ 1, ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
233  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
234  infot = 7
235  CALL sgeevx( 'N', 'N', 'N', 'N', 2, a, 1, wr, wi, vl, 1, vr, 1,
236  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
237  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
238  infot = 11
239  CALL sgeevx( 'N', 'V', 'N', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1,
240  $ ilo, ihi, s, abnrm, r1, r2, w, 6, iw, info )
241  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
242  infot = 13
243  CALL sgeevx( 'N', 'N', 'V', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1,
244  $ ilo, ihi, s, abnrm, r1, r2, w, 6, iw, info )
245  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
246  infot = 21
247  CALL sgeevx( 'N', 'N', 'N', 'N', 1, a, 1, wr, wi, vl, 1, vr, 1,
248  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
249  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
250  infot = 21
251  CALL sgeevx( 'N', 'V', 'N', 'N', 1, a, 1, wr, wi, vl, 1, vr, 1,
252  $ ilo, ihi, s, abnrm, r1, r2, w, 2, iw, info )
253  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
254  infot = 21
255  CALL sgeevx( 'N', 'N', 'V', 'V', 1, a, 1, wr, wi, vl, 1, vr, 1,
256  $ ilo, ihi, s, abnrm, r1, r2, w, 3, iw, info )
257  CALL chkxer( 'SGEEVX', infot, nout, lerr, ok )
258  nt = nt + 11
259 *
260  ELSE IF( lsamen( 2, c2, 'SX' ) ) THEN
261 *
262 * Test SGEESX
263 *
264  srnamt = 'SGEESX'
265  infot = 1
266  CALL sgeesx( 'X', 'N', sslect, 'N', 0, a, 1, sdim, wr, wi, vl,
267  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
268  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
269  infot = 2
270  CALL sgeesx( 'N', 'X', sslect, 'N', 0, a, 1, sdim, wr, wi, vl,
271  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
272  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
273  infot = 4
274  CALL sgeesx( 'N', 'N', sslect, 'X', 0, a, 1, sdim, wr, wi, vl,
275  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
276  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
277  infot = 5
278  CALL sgeesx( 'N', 'N', sslect, 'N', -1, a, 1, sdim, wr, wi, vl,
279  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
280  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
281  infot = 7
282  CALL sgeesx( 'N', 'N', sslect, 'N', 2, a, 1, sdim, wr, wi, vl,
283  $ 1, r1( 1 ), r2( 1 ), w, 6, iw, 1, b, info )
284  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
285  infot = 12
286  CALL sgeesx( 'V', 'N', sslect, 'N', 2, a, 2, sdim, wr, wi, vl,
287  $ 1, r1( 1 ), r2( 1 ), w, 6, iw, 1, b, info )
288  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
289  infot = 16
290  CALL sgeesx( 'N', 'N', sslect, 'N', 1, a, 1, sdim, wr, wi, vl,
291  $ 1, r1( 1 ), r2( 1 ), w, 2, iw, 1, b, info )
292  CALL chkxer( 'SGEESX', infot, nout, lerr, ok )
293  nt = nt + 7
294 *
295  ELSE IF( lsamen( 2, c2, 'BD' ) ) THEN
296 *
297 * Test SGESVD
298 *
299  srnamt = 'SGESVD'
300  infot = 1
301  CALL sgesvd( 'X', 'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
302  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
303  infot = 2
304  CALL sgesvd( 'N', 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
305  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
306  infot = 2
307  CALL sgesvd( 'O', 'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
308  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
309  infot = 3
310  CALL sgesvd( 'N', 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1,
311  $ info )
312  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
313  infot = 4
314  CALL sgesvd( 'N', 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1,
315  $ info )
316  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
317  infot = 6
318  CALL sgesvd( 'N', 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, info )
319  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
320  infot = 9
321  CALL sgesvd( 'A', 'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, info )
322  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
323  infot = 11
324  CALL sgesvd( 'N', 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, info )
325  CALL chkxer( 'SGESVD', infot, nout, lerr, ok )
326  nt = 8
327  IF( ok ) THEN
328  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
329  $ nt
330  ELSE
331  WRITE( nout, fmt = 9998 )
332  END IF
333 *
334 * Test SGESDD
335 *
336  srnamt = 'SGESDD'
337  infot = 1
338  CALL sgesdd( 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
339  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
340  infot = 2
341  CALL sgesdd( 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
342  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
343  infot = 3
344  CALL sgesdd( 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
345  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
346  infot = 5
347  CALL sgesdd( 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
348  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
349  infot = 8
350  CALL sgesdd( 'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, iw, info )
351  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
352  infot = 10
353  CALL sgesdd( 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
354  CALL chkxer( 'SGESDD', infot, nout, lerr, ok )
355  nt = 6
356  IF( ok ) THEN
357  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
358  $ nt
359  ELSE
360  WRITE( nout, fmt = 9998 )
361  END IF
362 *
363 * Test SGEJSV
364 *
365  srnamt = 'SGEJSV'
366  infot = 1
367  CALL sgejsv( 'X', 'U', 'V', 'R', 'N', 'N',
368  $ 0, 0, a, 1, s, u, 1, vt, 1,
369  $ w, 1, iw, info)
370  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
371  infot = 2
372  CALL sgejsv( 'G', 'X', 'V', 'R', 'N', 'N',
373  $ 0, 0, a, 1, s, u, 1, vt, 1,
374  $ w, 1, iw, info)
375  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
376  infot = 3
377  CALL sgejsv( 'G', 'U', 'X', 'R', 'N', 'N',
378  $ 0, 0, a, 1, s, u, 1, vt, 1,
379  $ w, 1, iw, info)
380  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
381  infot = 4
382  CALL sgejsv( 'G', 'U', 'V', 'X', 'N', 'N',
383  $ 0, 0, a, 1, s, u, 1, vt, 1,
384  $ w, 1, iw, info)
385  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
386  infot = 5
387  CALL sgejsv( 'G', 'U', 'V', 'R', 'X', 'N',
388  $ 0, 0, a, 1, s, u, 1, vt, 1,
389  $ w, 1, iw, info)
390  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
391  infot = 6
392  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'X',
393  $ 0, 0, a, 1, s, u, 1, vt, 1,
394  $ w, 1, iw, info)
395  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
396  infot = 7
397  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
398  $ -1, 0, a, 1, s, u, 1, vt, 1,
399  $ w, 1, iw, info)
400  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
401  infot = 8
402  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
403  $ 0, -1, a, 1, s, u, 1, vt, 1,
404  $ w, 1, iw, info)
405  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
406  infot = 10
407  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
408  $ 2, 1, a, 1, s, u, 1, vt, 1,
409  $ w, 1, iw, info)
410  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
411  infot = 13
412  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
413  $ 2, 2, a, 2, s, u, 1, vt, 2,
414  $ w, 1, iw, info)
415  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
416  infot = 14
417  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
418  $ 2, 2, a, 2, s, u, 2, vt, 1,
419  $ w, 1, iw, info)
420  CALL chkxer( 'SGEJSV', infot, nout, lerr, ok )
421  nt = 11
422  IF( ok ) THEN
423  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
424  $ nt
425  ELSE
426  WRITE( nout, fmt = 9998 )
427  END IF
428  END IF
429 *
430 * Print a summary line.
431 *
432  IF( .NOT.lsamen( 2, c2, 'BD' ) ) THEN
433  IF( ok ) THEN
434  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
435  $ nt
436  ELSE
437  WRITE( nout, fmt = 9998 )
438  END IF
439  END IF
440 *
441  9999 FORMAT( 1x, a, ' passed the tests of the error exits (', i3,
442  $ ' tests done)' )
443  9998 FORMAT( ' *** ', a, ' failed the tests of the error exits ***' )
444  RETURN
445 *
446 * End of SERRED
447 *
logical function sslect(ZR, ZI)
SSLECT
Definition: sslect.f:64
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
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
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:283
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 ...
Definition: sgees.f:218
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
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:191
subroutine sgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
SGESDD
Definition: sgesdd.f:218
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:213
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:305

Here is the call graph for this function:

Here is the caller graph for this function: