LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ derred()

subroutine derred ( character*3  PATH,
integer  NUNIT 
)

DERRED

Purpose:
 DERRED tests the error exits for the eigenvalue driver routines for
 DOUBLE PRECISION matrices:

 PATH  driver   description
 ----  ------   -----------
 SEV   DGEEV    find eigenvalues/eigenvectors for nonsymmetric A
 SES   DGEES    find eigenvalues/Schur form for nonsymmetric A
 SVX   DGEEVX   SGEEV + balancing and condition estimation
 SSX   DGEESX   SGEES + balancing and condition estimation
 DBD   DGESVD   compute SVD of an M-by-N matrix A
       DGESDD   compute SVD of an M-by-N matrix A (by divide and
                conquer)
       DGEJSV   compute SVD of an M-by-N matrix A where M >= N
       DGESVDX  compute SVD of an M-by-N matrix A(by bisection
                and inverse iteration)
       DGESVDQ  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.

Definition at line 69 of file derred.f.

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
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
logical function dslect(ZR, ZI)
DSLECT
Definition: dslect.f:62
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
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
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
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
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
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
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
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
subroutine dgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
DGESDD
Definition: dgesdd.f:219
Here is the call graph for this function:
Here is the caller graph for this function: