LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ cerred()

subroutine cerred ( character*3  PATH,
integer  NUNIT 
)

CERRED

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

 PATH  driver   description
 ----  ------   -----------
 CEV   CGEEV    find eigenvalues/eigenvectors for nonsymmetric A
 CES   CGEES    find eigenvalues/Schur form for nonsymmetric A
 CVX   CGEEVX   CGEEV + balancing and condition estimation
 CSX   CGEESX   CGEES + balancing and condition estimation
 CBD   CGESVD   compute SVD of an M-by-N matrix A
       CGESDD   compute SVD of an M-by-N matrix A(by divide and
                conquer)
       CGEJSV   compute SVD of an M-by-N matrix A where M >= N
       CGESVDX  compute SVD of an M-by-N matrix A(by bisection
                and inverse iteration)
       CGESVDQ  compute SVD of an M-by-N matrix A(with a 
                QR-Preconditioned )
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
June 2016

Definition at line 72 of file cerred.f.

72 *
73 * -- LAPACK test routine (version 3.7.0) --
74 * -- LAPACK is a software package provided by Univ. of Tennessee, --
75 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
76 * June 2016
77 *
78 * .. Scalar Arguments ..
79  CHARACTER*3 PATH
80  INTEGER NUNIT
81 * ..
82 *
83 * =====================================================================
84 *
85 * .. Parameters ..
86  INTEGER NMAX, LW
87  parameter( nmax = 4, lw = 5*nmax )
88  REAL ONE, ZERO
89  parameter( one = 1.0e0, zero = 0.0e0 )
90 * ..
91 * .. Local Scalars ..
92  CHARACTER*2 C2
93  INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
94  REAL ABNRM
95 * ..
96 * .. Local Arrays ..
97  LOGICAL B( NMAX )
98  INTEGER IW( 4*NMAX )
99  REAL R1( NMAX ), R2( NMAX ), RW( LW ), S( NMAX )
100  COMPLEX A( NMAX, NMAX ), U( NMAX, NMAX ),
101  $ VL( NMAX, NMAX ), VR( NMAX, NMAX ),
102  $ VT( NMAX, NMAX ), W( 10*NMAX ), X( NMAX )
103 * ..
104 * .. External Subroutines ..
105  EXTERNAL chkxer, cgees, cgeesx, cgeev, cgeevx, cgejsv,
106  $ cgesdd, cgesvd, cgesvdx, cgesvdq
107 * ..
108 * .. External Functions ..
109  LOGICAL LSAMEN, CSLECT
110  EXTERNAL lsamen, cslect
111 * ..
112 * .. Intrinsic Functions ..
113  INTRINSIC len_trim
114 * ..
115 * .. Arrays in Common ..
116  LOGICAL SELVAL( 20 )
117  REAL SELWI( 20 ), SELWR( 20 )
118 * ..
119 * .. Scalars in Common ..
120  LOGICAL LERR, OK
121  CHARACTER*32 SRNAMT
122  INTEGER INFOT, NOUT, SELDIM, SELOPT
123 * ..
124 * .. Common blocks ..
125  COMMON / infoc / infot, nout, ok, lerr
126  COMMON / srnamc / srnamt
127  COMMON / sslct / selopt, seldim, selval, selwr, selwi
128 * ..
129 * .. Executable Statements ..
130 *
131  nout = nunit
132  WRITE( nout, fmt = * )
133  c2 = path( 2: 3 )
134 *
135 * Initialize A
136 *
137  DO 20 j = 1, nmax
138  DO 10 i = 1, nmax
139  a( i, j ) = zero
140  10 CONTINUE
141  20 CONTINUE
142  DO 30 i = 1, nmax
143  a( i, i ) = one
144  30 CONTINUE
145  ok = .true.
146  nt = 0
147 *
148  IF( lsamen( 2, c2, 'EV' ) ) THEN
149 *
150 * Test CGEEV
151 *
152  srnamt = 'CGEEV '
153  infot = 1
154  CALL cgeev( 'X', 'N', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
155  $ info )
156  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
157  infot = 2
158  CALL cgeev( 'N', 'X', 0, a, 1, x, vl, 1, vr, 1, w, 1, rw,
159  $ info )
160  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
161  infot = 3
162  CALL cgeev( 'N', 'N', -1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
163  $ info )
164  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
165  infot = 5
166  CALL cgeev( 'N', 'N', 2, a, 1, x, vl, 1, vr, 1, w, 4, rw,
167  $ info )
168  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
169  infot = 8
170  CALL cgeev( 'V', 'N', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
171  $ info )
172  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
173  infot = 10
174  CALL cgeev( 'N', 'V', 2, a, 2, x, vl, 1, vr, 1, w, 4, rw,
175  $ info )
176  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
177  infot = 12
178  CALL cgeev( 'V', 'V', 1, a, 1, x, vl, 1, vr, 1, w, 1, rw,
179  $ info )
180  CALL chkxer( 'CGEEV ', infot, nout, lerr, ok )
181  nt = nt + 7
182 *
183  ELSE IF( lsamen( 2, c2, 'ES' ) ) THEN
184 *
185 * Test CGEES
186 *
187  srnamt = 'CGEES '
188  infot = 1
189  CALL cgees( 'X', 'N', cslect, 0, a, 1, sdim, x, vl, 1, w, 1,
190  $ rw, b, info )
191  CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
192  infot = 2
193  CALL cgees( 'N', 'X', cslect, 0, a, 1, sdim, x, vl, 1, w, 1,
194  $ rw, b, info )
195  CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
196  infot = 4
197  CALL cgees( 'N', 'S', cslect, -1, a, 1, sdim, x, vl, 1, w, 1,
198  $ rw, b, info )
199  CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
200  infot = 6
201  CALL cgees( 'N', 'S', cslect, 2, a, 1, sdim, x, vl, 1, w, 4,
202  $ rw, b, info )
203  CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
204  infot = 10
205  CALL cgees( 'V', 'S', cslect, 2, a, 2, sdim, x, vl, 1, w, 4,
206  $ rw, b, info )
207  CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
208  infot = 12
209  CALL cgees( 'N', 'S', cslect, 1, a, 1, sdim, x, vl, 1, w, 1,
210  $ rw, b, info )
211  CALL chkxer( 'CGEES ', infot, nout, lerr, ok )
212  nt = nt + 6
213 *
214  ELSE IF( lsamen( 2, c2, 'VX' ) ) THEN
215 *
216 * Test CGEEVX
217 *
218  srnamt = 'CGEEVX'
219  infot = 1
220  CALL cgeevx( 'X', 'N', 'N', 'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
221  $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
222  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
223  infot = 2
224  CALL cgeevx( 'N', 'X', 'N', 'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
225  $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
226  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
227  infot = 3
228  CALL cgeevx( 'N', 'N', 'X', 'N', 0, a, 1, x, vl, 1, vr, 1, ilo,
229  $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
230  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
231  infot = 4
232  CALL cgeevx( 'N', 'N', 'N', 'X', 0, a, 1, x, vl, 1, vr, 1, ilo,
233  $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
234  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
235  infot = 5
236  CALL cgeevx( 'N', 'N', 'N', 'N', -1, a, 1, x, vl, 1, vr, 1,
237  $ ilo, ihi, s, abnrm, r1, r2, w, 1, rw, info )
238  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
239  infot = 7
240  CALL cgeevx( 'N', 'N', 'N', 'N', 2, a, 1, x, vl, 1, vr, 1, ilo,
241  $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
242  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
243  infot = 10
244  CALL cgeevx( 'N', 'V', 'N', 'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
245  $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
246  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
247  infot = 12
248  CALL cgeevx( 'N', 'N', 'V', 'N', 2, a, 2, x, vl, 1, vr, 1, ilo,
249  $ ihi, s, abnrm, r1, r2, w, 4, rw, info )
250  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
251  infot = 20
252  CALL cgeevx( 'N', 'N', 'N', 'N', 1, a, 1, x, vl, 1, vr, 1, ilo,
253  $ ihi, s, abnrm, r1, r2, w, 1, rw, info )
254  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
255  infot = 20
256  CALL cgeevx( 'N', 'N', 'V', 'V', 1, a, 1, x, vl, 1, vr, 1, ilo,
257  $ ihi, s, abnrm, r1, r2, w, 2, rw, info )
258  CALL chkxer( 'CGEEVX', infot, nout, lerr, ok )
259  nt = nt + 10
260 *
261  ELSE IF( lsamen( 2, c2, 'SX' ) ) THEN
262 *
263 * Test CGEESX
264 *
265  srnamt = 'CGEESX'
266  infot = 1
267  CALL cgeesx( 'X', 'N', cslect, 'N', 0, a, 1, sdim, x, vl, 1,
268  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
269  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
270  infot = 2
271  CALL cgeesx( 'N', 'X', cslect, 'N', 0, a, 1, sdim, x, vl, 1,
272  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
273  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
274  infot = 4
275  CALL cgeesx( 'N', 'N', cslect, 'X', 0, a, 1, sdim, x, vl, 1,
276  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
277  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
278  infot = 5
279  CALL cgeesx( 'N', 'N', cslect, 'N', -1, a, 1, sdim, x, vl, 1,
280  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
281  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
282  infot = 7
283  CALL cgeesx( 'N', 'N', cslect, 'N', 2, a, 1, sdim, x, vl, 1,
284  $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
285  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
286  infot = 11
287  CALL cgeesx( 'V', 'N', cslect, 'N', 2, a, 2, sdim, x, vl, 1,
288  $ r1( 1 ), r2( 1 ), w, 4, rw, b, info )
289  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
290  infot = 15
291  CALL cgeesx( 'N', 'N', cslect, 'N', 1, a, 1, sdim, x, vl, 1,
292  $ r1( 1 ), r2( 1 ), w, 1, rw, b, info )
293  CALL chkxer( 'CGEESX', infot, nout, lerr, ok )
294  nt = nt + 7
295 *
296  ELSE IF( lsamen( 2, c2, 'BD' ) ) THEN
297 *
298 * Test CGESVD
299 *
300  srnamt = 'CGESVD'
301  infot = 1
302  CALL cgesvd( 'X', 'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
303  $ info )
304  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
305  infot = 2
306  CALL cgesvd( 'N', 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
307  $ info )
308  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
309  infot = 2
310  CALL cgesvd( 'O', 'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
311  $ info )
312  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
313  infot = 3
314  CALL cgesvd( 'N', 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw,
315  $ info )
316  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
317  infot = 4
318  CALL cgesvd( 'N', 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw,
319  $ info )
320  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
321  infot = 6
322  CALL cgesvd( 'N', 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw,
323  $ info )
324  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
325  infot = 9
326  CALL cgesvd( 'A', 'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw,
327  $ info )
328  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
329  infot = 11
330  CALL cgesvd( 'N', 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw,
331  $ info )
332  CALL chkxer( 'CGESVD', infot, nout, lerr, ok )
333  nt = nt + 8
334  IF( ok ) THEN
335  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
336  $ nt
337  ELSE
338  WRITE( nout, fmt = 9998 )
339  END IF
340 *
341 * Test CGESDD
342 *
343  srnamt = 'CGESDD'
344  infot = 1
345  CALL cgesdd( 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
346  $ info )
347  CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
348  infot = 2
349  CALL cgesdd( 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
350  $ info )
351  CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
352  infot = 3
353  CALL cgesdd( 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, rw, iw,
354  $ info )
355  CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
356  infot = 5
357  CALL cgesdd( 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
358  $ info )
359  CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
360  infot = 8
361  CALL cgesdd( 'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, rw, iw,
362  $ info )
363  CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
364  infot = 10
365  CALL cgesdd( 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, rw, iw,
366  $ info )
367  CALL chkxer( 'CGESDD', infot, nout, lerr, ok )
368  nt = nt - 2
369  IF( ok ) THEN
370  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
371  $ nt
372  ELSE
373  WRITE( nout, fmt = 9998 )
374  END IF
375 *
376 * Test CGEJSV
377 *
378  srnamt = 'CGEJSV'
379  infot = 1
380  CALL cgejsv( 'X', 'U', 'V', 'R', 'N', 'N',
381  $ 0, 0, a, 1, s, u, 1, vt, 1,
382  $ w, 1, rw, 1, iw, info)
383  CALL chkxer( 'CGEJSV', infot, nout, lerr, ok )
384  infot = 2
385  CALL cgejsv( 'G', 'X', 'V', 'R', 'N', 'N',
386  $ 0, 0, a, 1, s, u, 1, vt, 1,
387  $ w, 1, rw, 1, iw, info)
388  CALL chkxer( 'CGEJSV', infot, nout, lerr, ok )
389  infot = 3
390  CALL cgejsv( 'G', 'U', 'X', 'R', 'N', 'N',
391  $ 0, 0, a, 1, s, u, 1, vt, 1,
392  $ w, 1, rw, 1, iw, info)
393  CALL chkxer( 'CGEJSV', infot, nout, lerr, ok )
394  infot = 4
395  CALL cgejsv( 'G', 'U', 'V', 'X', 'N', 'N',
396  $ 0, 0, a, 1, s, u, 1, vt, 1,
397  $ w, 1, rw, 1, iw, info)
398  CALL chkxer( 'CGEJSV', infot, nout, lerr, ok )
399  infot = 5
400  CALL cgejsv( 'G', 'U', 'V', 'R', 'X', 'N',
401  $ 0, 0, a, 1, s, u, 1, vt, 1,
402  $ w, 1, rw, 1, iw, info)
403  CALL chkxer( 'CGEJSV', infot, nout, lerr, ok )
404  infot = 6
405  CALL cgejsv( 'G', 'U', 'V', 'R', 'N', 'X',
406  $ 0, 0, a, 1, s, u, 1, vt, 1,
407  $ w, 1, rw, 1, iw, info)
408  CALL chkxer( 'CGEJSV', infot, nout, lerr, ok )
409  infot = 7
410  CALL cgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
411  $ -1, 0, a, 1, s, u, 1, vt, 1,
412  $ w, 1, rw, 1, iw, info)
413  CALL chkxer( 'CGEJSV', infot, nout, lerr, ok )
414  infot = 8
415  CALL cgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
416  $ 0, -1, a, 1, s, u, 1, vt, 1,
417  $ w, 1, rw, 1, iw, info)
418  CALL chkxer( 'CGEJSV', infot, nout, lerr, ok )
419  infot = 10
420  CALL cgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
421  $ 2, 1, a, 1, s, u, 1, vt, 1,
422  $ w, 1, rw, 1, iw, info)
423  CALL chkxer( 'CGEJSV', infot, nout, lerr, ok )
424  infot = 13
425  CALL cgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
426  $ 2, 2, a, 2, s, u, 1, vt, 2,
427  $ w, 1, rw, 1, iw, info)
428  CALL chkxer( 'CGEJSV', infot, nout, lerr, ok )
429  infot = 15
430  CALL cgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
431  $ 2, 2, a, 2, s, u, 2, vt, 1,
432  $ w, 1, rw, 1, iw, info)
433  CALL chkxer( 'CGEJSV', infot, nout, lerr, ok )
434  nt = 11
435  IF( ok ) THEN
436  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
437  $ nt
438  ELSE
439  WRITE( nout, fmt = 9998 )
440  END IF
441 *
442 * Test CGESVDX
443 *
444  srnamt = 'CGESVDX'
445  infot = 1
446  CALL cgesvdx( 'X', 'N', 'A', 0, 0, a, 1, zero, zero,
447  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
448  CALL chkxer( 'CGESVDX', infot, nout, lerr, ok )
449  infot = 2
450  CALL cgesvdx( 'N', 'X', 'A', 0, 0, a, 1, zero, zero,
451  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
452  CALL chkxer( 'CGESVDX', infot, nout, lerr, ok )
453  infot = 3
454  CALL cgesvdx( 'N', 'N', 'X', 0, 0, a, 1, zero, zero,
455  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
456  CALL chkxer( 'CGESVDX', infot, nout, lerr, ok )
457  infot = 4
458  CALL cgesvdx( 'N', 'N', 'A', -1, 0, a, 1, zero, zero,
459  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
460  CALL chkxer( 'CGESVDX', infot, nout, lerr, ok )
461  infot = 5
462  CALL cgesvdx( 'N', 'N', 'A', 0, -1, a, 1, zero, zero,
463  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
464  CALL chkxer( 'CGESVDX', infot, nout, lerr, ok )
465  infot = 7
466  CALL cgesvdx( 'N', 'N', 'A', 2, 1, a, 1, zero, zero,
467  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
468  CALL chkxer( 'CGESVDX', infot, nout, lerr, ok )
469  infot = 8
470  CALL cgesvdx( 'N', 'N', 'V', 2, 1, a, 2, -one, zero,
471  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
472  CALL chkxer( 'CGESVDX', infot, nout, lerr, ok )
473  infot = 9
474  CALL cgesvdx( 'N', 'N', 'V', 2, 1, a, 2, one, zero,
475  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
476  CALL chkxer( 'CGESVDX', infot, nout, lerr, ok )
477  infot = 10
478  CALL cgesvdx( 'N', 'N', 'I', 2, 2, a, 2, zero, zero,
479  $ 0, 1, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
480  CALL chkxer( 'CGESVDX', infot, nout, lerr, ok )
481  infot = 11
482  CALL cgesvdx( 'V', 'N', 'I', 2, 2, a, 2, zero, zero,
483  $ 1, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
484  CALL chkxer( 'CGESVDX', infot, nout, lerr, ok )
485  infot = 15
486  CALL cgesvdx( 'V', 'N', 'A', 2, 2, a, 2, zero, zero,
487  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
488  CALL chkxer( 'CGESVDX', infot, nout, lerr, ok )
489  infot = 17
490  CALL cgesvdx( 'N', 'V', 'A', 2, 2, a, 2, zero, zero,
491  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, rw, iw, info )
492  CALL chkxer( 'CGESVDX', infot, nout, lerr, ok )
493  nt = 12
494  IF( ok ) THEN
495  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
496  $ nt
497  ELSE
498  WRITE( nout, fmt = 9998 )
499  END IF
500 *
501 * Test CGESVDQ
502 *
503  srnamt = 'CGESVDQ'
504  infot = 1
505  CALL cgesvdq( 'X', 'P', 'T', 'A', 'A', 0, 0, a, 1, s, u,
506  $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
507  CALL chkxer( 'CGESVDQ', infot, nout, lerr, ok )
508  infot = 2
509  CALL cgesvdq( 'A', 'X', 'T', 'A', 'A', 0, 0, a, 1, s, u,
510  $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
511  CALL chkxer( 'CGESVDQ', infot, nout, lerr, ok )
512  infot = 3
513  CALL cgesvdq( 'A', 'P', 'X', 'A', 'A', 0, 0, a, 1, s, u,
514  $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
515  CALL chkxer( 'CGESVDQ', infot, nout, lerr, ok )
516  infot = 4
517  CALL cgesvdq( 'A', 'P', 'T', 'X', 'A', 0, 0, a, 1, s, u,
518  $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
519  CALL chkxer( 'CGESVDQ', infot, nout, lerr, ok )
520  infot = 5
521  CALL cgesvdq( 'A', 'P', 'T', 'A', 'X', 0, 0, a, 1, s, u,
522  $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
523  CALL chkxer( 'CGESVDQ', infot, nout, lerr, ok )
524  infot = 6
525  CALL cgesvdq( 'A', 'P', 'T', 'A', 'A', -1, 0, a, 1, s, u,
526  $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
527  CALL chkxer( 'CGESVDQ', infot, nout, lerr, ok )
528  infot = 7
529  CALL cgesvdq( 'A', 'P', 'T', 'A', 'A', 0, 1, a, 1, s, u,
530  $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
531  CALL chkxer( 'CGESVDQ', infot, nout, lerr, ok )
532  infot = 9
533  CALL cgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 0, s, u,
534  $ 0, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
535  CALL chkxer( 'CGESVDQ', infot, nout, lerr, ok )
536  infot = 12
537  CALL cgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
538  $ -1, vt, 0, ns, iw, 1, w, 1, rw, 1, info )
539  CALL chkxer( 'CGESVDQ', infot, nout, lerr, ok )
540  infot = 14
541  CALL cgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
542  $ 1, vt, -1, ns, iw, 1, w, 1, rw, 1, info )
543  CALL chkxer( 'CGESVDQ', infot, nout, lerr, ok )
544  infot = 17
545  CALL cgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
546  $ 1, vt, 1, ns, iw, -5, w, 1, rw, 1, info )
547  CALL chkxer( 'CGESVDQ', infot, nout, lerr, ok )
548  nt = 11
549  IF( ok ) THEN
550  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
551  $ nt
552  ELSE
553  WRITE( nout, fmt = 9998 )
554  END IF
555  END IF
556 *
557 * Print a summary line.
558 *
559  IF( .NOT.lsamen( 2, c2, 'BD' ) ) THEN
560  IF( ok ) THEN
561  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
562  $ nt
563  ELSE
564  WRITE( nout, fmt = 9998 )
565  END IF
566  END IF
567 *
568  9999 FORMAT( 1x, a, ' passed the tests of the error exits (', i3,
569  $ ' tests done)' )
570  9998 FORMAT( ' *** ', a, ' failed the tests of the error exits ***' )
571  RETURN
572 *
573 * End of CERRED
574 *
Here is the call graph for this function:
Here is the caller graph for this function:
cgeev
subroutine cgeev(JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
CGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
Definition: cgeev.f:181
cgees
subroutine cgees(JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, LDVS, WORK, LWORK, RWORK, BWORK, INFO)
CGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE m...
Definition: cgees.f:199
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
cslect
logical function cslect(Z)
CSLECT
Definition: cslect.f:58
cgeevx
subroutine cgeevx(BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, RWORK, INFO)
CGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
Definition: cgeevx.f:289
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
cgesdd
subroutine cgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, IWORK, INFO)
CGESDD
Definition: cgesdd.f:228
cgesvdx
subroutine cgesvdx(JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, IL, IU, NS, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, IWORK, INFO)
CGESVDX computes the singular value decomposition (SVD) for GE matrices
Definition: cgesvdx.f:272
cgesvd
subroutine cgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, INFO)
CGESVD computes the singular value decomposition (SVD) for GE matrices
Definition: cgesvd.f:216
cgesvdq
subroutine cgesvdq(JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK, CWORK, LCWORK, RWORK, LRWORK, INFO)
CGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE...
Definition: cgesvdq.f:415
cgeesx
subroutine cgeesx(JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK, BWORK, INFO)
CGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
Definition: cgeesx.f:241
cgejsv
subroutine cgejsv(JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, M, N, A, LDA, SVA, U, LDU, V, LDV, CWORK, LWORK, RWORK, LRWORK, IWORK, INFO)
CGEJSV
Definition: cgejsv.f:570